home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istpl / PLLIB.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  137.0 KB  |  3,717 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.5
  3. C---------------------------------------------------------
  4. C
  5. C       Toolpack POLISH-77: a Fortran-77 pretty-printer.
  6. C
  7. C       Programmed by Malcolm Cohen, NAG, June 1984 (Version 0.1)
  8. C
  9. C       Revised July-August 1984
  10. C           (Version 0.2)
  11. C       Revised November-December 1984
  12. C           (for Toolpack/1 version 1.1)
  13. C       Revised September 1985
  14. C           (for Toolpack/1 version 2.1)
  15. C
  16. C       Step 1    Produce compilable output using an extensible framework
  17. C       Step 1.5  Make the continuation character programmable
  18. C       Step 2    Add table-driven token spacing
  19. C       Step 2.5  Detect labels and format them as required
  20. C       Step 2.6  Separate monadic plus/minus tokens from binary
  21. C       Step 3    Indentation
  22. C       Step 3.5  Intelligent line breaking
  23. C       Step 4    Blank line insertion
  24. C       Step 5    Sequence numbering
  25. C       Step 6    Statement re-labelling
  26. C       Step 7    Move FORMAT statements
  27. C       Step 8    Ensure DO-loops end on unique CONTINUE statements
  28. C       Step 9    Comment processing
  29. C       Step 9.5  Case conversion
  30. C       Step 10   Parameter input
  31. C       Step 10.5 Process Source-Embedded Directives
  32. C       Step 11   Simple-minded assignment line-up capability (V1)
  33. C       Step 12   Declaration body line-up capability (V1.0)
  34. C       Step 13   Progress trace facility (V1.0)
  35. C       Step 14   Add incremental parameter setting (V1.1)
  36. C       Step 15   Add even more options (INDDOC,DELSED,BRKLIF) (V1.1)
  37. C       Step 16   Additional options for V2.1
  38. C
  39. C ****************************************
  40. C *
  41. C * As of step 16, parameters are:
  42. C * ------------------------------
  43. C * LMARGS,RMARGS: Margin control (statements)
  44. C * LMARGC,RMARGC: Margin control (comments)
  45. C * CONCHR: Continuation line character control
  46. C * SPBEF,SPAFT: Token spacing
  47. C * LABELF: Label format control
  48. C * LABELC: Label starting column
  49. C * INDDO,INDIF,INDCON: Indentation amounts
  50. C * INDCMT: Indentation control for comments
  51. C * BRPRIO: Breakage priority for each token/parenlevel
  52. C * BLBEF,BLAFT,BLADEC,BLCHAR: Blank line insertion
  53. C * SEQRQD,SEQINI,SEQINC,SEQDIG,SEQFIL: Sequence numbering
  54. C * FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM: Relabelling
  55. C * MOVEF: Move FORMAT statements switch
  56. C * DOCONI: DO-loop CONTINUE insertion
  57. C * IOTHCO: Insertion of Other CONTINUE statements
  58. C * CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR: Comment processing
  59. C * KWCASE,IDCASE,STRCAS,CMCASE,FFCASE: Case conversion
  60. C * VLEN: Variable length for assignment line-up
  61. C * DLEN,DLUP: Declaration keyword length and body line-up
  62. C * TRACE: Trace progress
  63. C * INDDOC: Indent DO-loop CONTINUEs
  64. C * DELSED: Delete source-embedded directives for ISTPL
  65. C * BRKLIF: Break logical IF statements after condition
  66. C * ERRCMT: Insert error messages into program as comments
  67. C * CVTHFM: Convert H-edit descriptors to character strings
  68. C * FFCASE: Case of format field descriptors
  69. C * RMOPCF: Optional comma removal in FORMAT statements
  70. C * SEQDIG: Number of digits in sequence numbers
  71. C * SEQFIL: Fill character for sequence numbers
  72. C * FMSBRK: Break strings nicely in FORMAT statements
  73. C *
  74. C ****************************************
  75.  
  76. C ****************************************
  77. C *
  78. C * Other Variables:
  79. C * ----------------
  80. C * MAXIND  -  Maximum indentation value (2/3rds along the line)
  81. C *
  82. C ****************************************
  83.  
  84. C ****************************************
  85. C *
  86. C * State Variables:
  87. C * ----------------
  88. C * LABEL         Label of current statement
  89. C * FSTTOK        First (non-label) token of current statement
  90. C * LASTST        First token of last statement
  91. C * LASTTK        Token before current
  92. C * CONCOL        Column for a continuation line to begin on, or 0
  93. C * DOLVL         DO-loop nexting level
  94. C * IFLVL         block-IF nesting level
  95. C * DOLBL(n)      Ending label of DO-loop at nesting level n
  96. C * BRKPOS        Best position to break line at or 0
  97. C * BRKPRI        Priority of that position (ie how good it is)
  98. C * MINBRK        Minimum break position (halfway along the line)
  99. C * LNUMBR        Line number (for sequence numbers and error messages)
  100. C * FLBNUM        Next FORMAT statement label (when relabelling)
  101. C * SLBNUM        Next executable statement label (ditto)
  102. C * LBLUNK        Number of currently unknown labels (ref'ed but not defined)
  103. C * LBLTBI        Table of labels in input (when relabelling)
  104. C * LBLTBO        Corresponding labels for output (ditto)
  105. C * LBLTOP        Highest used element of LBLTBI/LBLTBO
  106. C * BEGUN         We have actually started outputting source code
  107. C *               for the current program unit (as vs. comments)
  108. C * BEGCMT        There are comments at the beginning of the program unit
  109. C *               which have not yet been written to the output file
  110. C *
  111. C * Also: (ie not in /STATE/ but still that sort of variable:
  112. C *
  113. C * PUNAME        Program unit name (for seq numbers and err messages)
  114. C * CONCNT        Number of continuation lines of current statement
  115. C * NDOCON        Number of CONTINUEs added to DO-loops due to duplicate
  116. C *               ending labels
  117. C * DOCONS(n)     New internal label number for ending DO-loop at nesting
  118. C *               level n, or 0.
  119. C * DLUPOS        Declaration line-up position
  120. C * MFFLAG        => We actually do have FORMAT statements to move
  121. C *
  122. C ****************************************
  123. C
  124. C ------------------------------------------------------------------------
  125. C
  126. C       P O L I S H   -   Polish a single statement
  127. C
  128.  
  129.         SUBROUTINE POLISH(NOTDON)
  130.         LOGICAL NOTDON
  131.  
  132. C---------------------------------------------------------
  133. C    TOOLPACK/1    Release: 2.5
  134. C---------------------------------------------------------
  135. C
  136. C  TKLAST = LAST TOKEN NUMBER
  137. C
  138.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  139.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  140.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  141.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  142.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  143.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  144.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  145.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  146.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  147.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  148.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  149.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  150.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  151.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  152.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  153.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  154.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  155.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  156.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  157.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  158.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  159.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  160.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  161.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  162.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  163.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  164.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  165.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  166.  
  167.  
  168.         COMMON/TYPES/ STTYPE
  169.         INTEGER STTYPE(TKLAST)
  170.  
  171.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  172.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  173.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  174.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  175.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  176.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  177.      +          ,LBLTBO(500),LBLTOP
  178.         LOGICAL BEGUN,BEGCMT
  179.  
  180.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  181.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  182.      +          NXTTXT(1322)
  183.  
  184.         INTEGER I
  185.  
  186.         SAVE
  187.  
  188.         INTEGER CTOI
  189.         EXTERNAL CTOI,ERROR
  190.  
  191.         PRNLVL=0
  192.         LABEL=0
  193.         IF (TOKTYP.EQ.TZEOF) THEN
  194.             IF (LASTST.NE.TEND) CALL PLERR('Missing END statement')
  195.             CALL POLFIN
  196.             TOKTYP=0
  197.             NOTDON = .FALSE.
  198.             RETURN
  199.         ELSE IF (TOKTYP.EQ.0) THEN
  200.             CALL ERROR('POLISH called after end of program')
  201.         END IF
  202.         NOTDON = .TRUE.
  203.  
  204.         IF (TOKTYP.EQ.TDCNST) THEN
  205.             I=1
  206.             LABEL=CTOI(TOKTXT,I)
  207.  100        CALL RDTOK
  208.             IF (TOKTYP.EQ.TCMMNT) THEN
  209.                 CALL PLERR('Embedded comment after label moved')
  210.                 CALL OUTCMT
  211.                 GOTO 100
  212.             END IF
  213.         ENDIF
  214.         FSTTOK=TOKTYP
  215.         IF (TOKTYP.EQ.TEND) THEN
  216.             IF (NXTTYP.NE.TZEOS)
  217.      +          CALL PLERR('Invalid END statement')
  218.             CALL PROEND
  219.             LASTST=FSTTOK
  220.         ELSE
  221.             IF (STTYPE(TOKTYP).EQ.1) THEN
  222.                 CALL PROCMT
  223.             ELSE IF (STTYPE(TOKTYP).EQ.2) THEN
  224.                 CALL PROFMT
  225.             ELSE IF (STTYPE(TOKTYP).EQ.3) THEN
  226.                 CALL PRODEC
  227.             ELSE IF (STTYPE(TOKTYP).EQ.4) THEN
  228.                 CALL PROEXE
  229.             ELSE
  230.                 CALL PLERR('Unexpected statement type')
  231.             END IF
  232.             CALL PROEOS
  233.             LASTST=FSTTOK
  234.         END IF
  235.  
  236.         END
  237. C ------------------------------------------------------------------------
  238. C
  239. C       P L O P T F  -  Read and obey a polish option file
  240. C
  241.  
  242.         SUBROUTINE PLOPTF(IODOPT)
  243.         INTEGER IODOPT
  244.  
  245.         INTEGER OPTLEN,OPT(134),I
  246.  
  247.         INTEGER ZGTCMD
  248.         EXTERNAL ZGTCMD
  249.  
  250.         IF (IODOPT.NE.-1) THEN
  251.  100        OPTLEN=ZGTCMD(OPT,IODOPT)
  252.             IF (OPTLEN.NE.-100) THEN
  253.                 CALL POLOPT(OPT,.FALSE.)
  254.                 GOTO 100
  255.             END IF
  256.         END IF
  257.  
  258.         END
  259. C ----------------------------------------------------------------------
  260. C
  261. C       T M P F I L   -   Create a temporary file
  262. C
  263.  
  264.         INTEGER FUNCTION TMPFIL(PATH)
  265.         INTEGER PATH(81)
  266.  
  267.         INTEGER CREATE
  268.         EXTERNAL CREATE,ZITOCP
  269.  
  270.         INTEGER TMPNUM
  271.  
  272.         TMPFIL=CREATE(PATH,2)
  273.         IF (TMPFIL.NE.-1) RETURN
  274.         TMPNUM=0
  275.  100    CALL ZITOCP(TMPNUM,PATH(4),3,48)
  276.         PATH(7)=46
  277.         TMPFIL=CREATE(PATH,2)
  278.         IF (TMPFIL.EQ.-1 .AND. TMPNUM.LT.999) THEN
  279.             TMPNUM=TMPNUM+1
  280.             GOTO 100
  281.         ELSE IF (TMPNUM.EQ.999) THEN
  282.             CALL ERROR('Can''t create temporary scratch file')
  283.         END IF
  284.  
  285.         END
  286. C ----------------------------------------------------------------------
  287. C
  288. C       I N I P O L  -  Initialise polish variables
  289. C
  290.  
  291.         SUBROUTINE INIPOL(INDESC,POLFD)
  292.         INTEGER INDESC,POLFD
  293.  
  294. C---------------------------------------------------------
  295. C    TOOLPACK/1    Release: 2.5
  296. C---------------------------------------------------------
  297. C
  298. C  TKLAST = LAST TOKEN NUMBER
  299. C
  300.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  301.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  302.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  303.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  304.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  305.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  306.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  307.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  308.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  309.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  310.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  311.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  312.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  313.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  314.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  315.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  316.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  317.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  318.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  319.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  320.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  321.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  322.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  323.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  324.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  325.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  326.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  327.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  328.  
  329.  
  330.         COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  331.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  332.  
  333.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  334.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  335.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  336.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  337.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  338.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  339.      +          ,LBLTBO(500),LBLTOP
  340.         LOGICAL BEGUN,BEGCMT
  341.  
  342.         COMMON/CONTIN/CONCHR,CONCNT
  343.         INTEGER CONCHR,CONCNT
  344.  
  345.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  346.         INTEGER INDDO,INDIF,INDCON,MAXIND
  347.         LOGICAL INDCMT
  348.  
  349.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  350.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  351.  
  352.         COMMON/OUTLIN/LINE,CURSOR
  353.         INTEGER LINE(134),CURSOR
  354.  
  355.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  356.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  357.      +          NXTTXT(1322)
  358.  
  359.         COMMON/MOVFMT/MOVEF,MFFLAG
  360.         LOGICAL MOVEF,MFFLAG
  361.  
  362.         COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
  363.         LOGICAL DOCONI,IOTHCO
  364.         INTEGER NDOCON,DOCONS(30)
  365.  
  366.         COMMON/ERTEST/NERROR
  367.         INTEGER NERROR
  368.  
  369.         COMMON/NAME/PUNAME
  370.         CHARACTER*6 PUNAME
  371.  
  372.         COMMON/DECLUP/DLUP,DLEN,DLUPOS
  373.         LOGICAL DLUP
  374.         INTEGER DLEN,DLUPOS
  375.  
  376.         COMMON/OPT15C/INDDOC,DELSED,BRKLIF
  377.         LOGICAL INDDOC,DELSED,BRKLIF
  378.  
  379.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  380.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  381.         LOGICAL SEQRQD
  382.  
  383.         COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  384.         INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  385.  
  386.         COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
  387.         INTEGER FLBINI,FLBINC,SLBINI,SLBINC
  388.         LOGICAL RLBFMT,RLBSTM
  389.  
  390.         SAVE
  391.  
  392.         COMMON/SCRATC/RLBPTH,FMTPTH,SCRPTH
  393.         INTEGER RLBPTH(81),FMTPTH(81),SCRPTH(81)
  394.  
  395.         INTEGER TMPFIL
  396.  
  397.         EXTERNAL ERROR
  398.  
  399.         MAXIND=(LMARGS+RMARGS*2)/3
  400.  
  401. C Check some consistency things
  402.  
  403.         IF (CMMODE.EQ.2) THEN
  404.             IF (SEQRQD) CALL REMARK(
  405.      +'Warning: sequence numbering applied to verbatim comment lines')
  406.             CBOX=0
  407.             CMCHAR=32
  408.             INDCMT=.FALSE.
  409.         END IF
  410.         IF (RMARGC.GT.72 .AND. SEQRQD)
  411.      +    CALL ERROR('RMARGC > 72, a'//'nd sequence numbers requested')
  412.         IF (DOCONI .AND. .NOT. RLBSTM)
  413.      +      CALL ERROR('DOCONI a'//'nd n'//'ot RLBSTM')
  414.         IF (INDDOC .AND. .NOT. DOCONI)
  415.      +      CALL ERROR('INDDOC a'//'nd n'//'ot DOCONI')
  416.         IF (LMARGS.GT.RMARGS)
  417.      +      CALL ERROR('LMARGS is great'//'er than RMARGS')
  418.  
  419. C Assign file descriptors
  420.  
  421.         TKDESC=INDESC
  422.         IODPOL=POLFD
  423.  
  424. C Open temporary files
  425.  
  426.         IF (RLBSTM .OR. RLBFMT) IODRLB=TMPFIL(RLBPTH)
  427.         IF (MOVEF) IODFMT=TMPFIL(FMTPTH)
  428.         IF (SEQRQD .OR. CBOX.GT.0) IODSCR=TMPFIL(SCRPTH)
  429.  
  430. C Initialise state variables
  431.  
  432.         IODCUR=IODPOL
  433.         DO 100 CURSOR=1,132
  434.             LINE(CURSOR)=32
  435.  100    CONTINUE
  436.         CURSOR=1
  437.         CONCNT=0
  438.         CONCOL=0
  439.         DOLVL=0
  440.         IFLVL=0
  441.         BRKPOS=0
  442.         BRKPRI=0
  443.         LASTST=TEND
  444.         PUNAME='MAIN  '
  445.         LNUMBR=SEQINI
  446.         LBLTOP=0
  447.         LBLUNK=0
  448.         FLBNUM=-1
  449.         SLBNUM=-1
  450.         NDOCON=0
  451.         NERROR=0
  452.         DLUPOS=0
  453.         MFFLAG=.FALSE.
  454.         BEGUN=.FALSE.
  455.         BEGCMT=.FALSE.
  456.  
  457. C Initialise buffered input
  458.  
  459.         TOKTYP=0
  460.         NXTTYP=0
  461.         NXTLEN=0
  462.         NXTTXT(1)=129
  463.         CALL RDTOK
  464.         CALL RDTOK
  465.  
  466.         END
  467. C ----------------------------------------------------------------------
  468. C
  469. C       P L S F N B   -   Polish Scratch File Name Blockdata
  470. C
  471.  
  472.         BLOCK DATA PLSFNB
  473.  
  474.         COMMON/SCRATC/RLBPTH,FMTPTH,SCRPTH
  475.         INTEGER RLBPTH(81),FMTPTH(81),SCRPTH(81)
  476.  
  477.         INTEGER I
  478.  
  479.         SAVE
  480.  
  481.         DATA (RLBPTH(I),I=1,11)/112,111,108,114,108,98,
  482.      +          46,116,109,112,129/
  483.      +       (FMTPTH(I),I=1,11)/112,111,108,102,109,116,
  484.      +          46,116,109,112,129/
  485.      +       (SCRPTH(I),I=1,11)/112,111,108,115,99,114,
  486.      +          46,116,109,112,129/
  487.  
  488.         END
  489. C ----------------------------------------------------------------------
  490. C
  491. C       P O L F I N   -   Tidy up after finishing the polish
  492. C
  493.  
  494.         SUBROUTINE POLFIN
  495.  
  496.         COMMON/SCRATC/RLBPTH,FMTPTH,SCRPTH
  497.         INTEGER RLBPTH(81),FMTPTH(81),SCRPTH(81)
  498.  
  499.         COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
  500.         INTEGER FLBINI,FLBINC,SLBINI,SLBINC
  501.         LOGICAL RLBFMT,RLBSTM
  502.  
  503.         COMMON/MOVFMT/MOVEF,MFFLAG
  504.         LOGICAL MOVEF,MFFLAG
  505.  
  506.         COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  507.         INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  508.  
  509.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  510.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  511.         LOGICAL SEQRQD
  512.  
  513.         COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  514.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  515.  
  516.         SAVE
  517.  
  518.         EXTERNAL REMOVE,CLOSE
  519.  
  520.         IF (RLBSTM .OR. RLBFMT) THEN
  521.             CALL CLOSE(IODRLB)
  522.             CALL REMOVE(RLBPTH)
  523.         END IF
  524.         IF (MOVEF) THEN
  525.             CALL CLOSE(IODFMT)
  526.             CALL REMOVE(FMTPTH)
  527.         END IF
  528.         IF (SEQRQD .OR. CBOX.GT.0) THEN
  529.             CALL CLOSE(IODSCR)
  530.             CALL REMOVE(SCRPTH)
  531.         END IF
  532.  
  533.         END
  534. C ----------------------------------------------------------------------
  535. C
  536. C       R D T O K  -  Read token (via lookahead buffer)
  537. C
  538.  
  539.         SUBROUTINE RDTOK
  540.  
  541. C---------------------------------------------------------
  542. C    TOOLPACK/1    Release: 2.5
  543. C---------------------------------------------------------
  544. C
  545. C  TKLAST = LAST TOKEN NUMBER
  546. C
  547.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  548.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  549.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  550.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  551.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  552.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  553.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  554.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  555.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  556.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  557.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  558.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  559.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  560.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  561.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  562.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  563.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  564.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  565.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  566.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  567.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  568.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  569.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  570.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  571.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  572.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  573.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  574.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  575.  
  576.  
  577. C This parameter is the maximum sized token we want to ever receive
  578.         INTEGER MAXL
  579.         PARAMETER (MAXL = 1322 - 4)
  580.  
  581.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  582.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  583.      +          NXTTXT(1322)
  584.  
  585.         COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  586.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  587.  
  588.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  589.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  590.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  591.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  592.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  593.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  594.      +          ,LBLTBO(500),LBLTOP
  595.         LOGICAL BEGUN,BEGCMT
  596.  
  597.         COMMON/XTTYPE/TMPLUS,TMMINU
  598.         INTEGER TMPLUS,TMMINU
  599.  
  600.         COMMON/OPT15C/INDDOC,DELSED,BRKLIF
  601.         LOGICAL INDDOC,DELSED,BRKLIF
  602.  
  603.         COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  604.         INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  605.  
  606.         COMMON/CVTOPT/CVTHFM,FMSBRK
  607.         LOGICAL CVTHFM,FMSBRK
  608.  
  609.         COMMON/REMTOK/RMOPCF
  610.         LOGICAL RMOPCF
  611.  
  612.         SAVE
  613.  
  614.         INTEGER I,STATUS,BIND,ID(3),TEXT(1322)
  615.         LOGICAL SEDDEL
  616.  
  617.         INTEGER ZSEDID,LENGTH,ZTOKTX
  618.         EXTERNAL SCOPY,ZGETTK,ERROR,ZSEDID,ZTOKTX,LENGTH
  619.  
  620.  100    SEDDEL=.FALSE.
  621.         LASTTK=TOKTYP
  622.         TOKTYP=NXTTYP
  623.         TOKLEN=NXTLEN
  624.         CALL SCOPY(NXTTXT,1,TOKTXT,1)
  625.         IF (TOKTYP.EQ.TCMMNT) THEN
  626.             IF (CMMODE.EQ.3 .AND. TOKLEN.GT.0) THEN
  627.                 TOKLEN=MIN(TOKLEN,72)
  628.  200            IF (TOKTXT(TOKLEN).EQ.32) THEN
  629.                     TOKLEN=TOKLEN-1
  630.                     IF (TOKLEN.GT.0) GOTO 200
  631.                 END IF
  632.                 TOKTXT(TOKLEN+1)=129
  633.             END IF
  634.             IF (ZSEDID(TOKTXT,BIND,ID,TEXT).EQ.-2) THEN
  635.                 IF (ID(1).EQ.112 .AND. ID(2).EQ.108) THEN
  636.                     CALL POLOPT(TEXT,.TRUE.)
  637.                     SEDDEL=DELSED
  638.                 END IF
  639.             END IF
  640.         END IF
  641.         IF (TOKTYP.NE.TZEOF) THEN
  642.             CALL ZGETTK(NXTTYP,NXTLEN,NXTTXT,TKDESC,STATUS)
  643.             IF (NXTLEN .GT. MAXL)
  644.      +          CALL ERROR('Token too long, recovery impossible')
  645.             IF (STATUS.EQ.-1) CALL ERROR('Token Read Failed')
  646.             IF (STATUS.EQ.-100) CALL ERROR('Incomplete token file')
  647.  
  648.             IF (RMOPCF .AND. FSTTOK.EQ.TFORMA .AND.
  649.      +          NXTTYP.EQ.TCOMMA .AND. (TOKTYP.EQ.TSLASH .OR.
  650.      +          TOKTYP.EQ.TCOLON)) THEN
  651.                 CALL ZGETTK(NXTTYP,NXTLEN,NXTTXT,TKDESC,STATUS)
  652.                 IF (NXTLEN .GT. MAXL)
  653.      +              CALL ERROR('Token too long, recovery impossible')
  654.                 IF (STATUS.EQ.-1) CALL ERROR('Token Read Failed')
  655.                 IF (STATUS.EQ.-100) CALL ERROR('Incomplete token file')
  656.             END IF
  657.  
  658.             IF (NXTTYP.EQ.THCNST .AND. FSTTOK.EQ.TFORMA .AND. CVTHFM)
  659.      +          NXTTYP=TCCNST
  660.             STATUS=ZTOKTX(NXTTYP,NXTLEN,NXTTXT,TEXT)
  661.             CALL CASCVT(NXTTYP,NXTLEN,TEXT)
  662.             NXTLEN=LENGTH(TEXT)
  663.             IF (NXTLEN.GT.0) THEN
  664.                 IF (TEXT(NXTLEN).EQ.32 .AND. NXTTYP.NE.THCNST) THEN
  665.                     TEXT(NXTLEN)=129
  666.                     NXTLEN=NXTLEN-1
  667.                 END IF
  668.             END IF
  669.             CALL SCOPY(TEXT,1,NXTTXT,1)
  670.  
  671. C "+" & "-" are binary iff last token was ")", <name>, or <number>
  672.  
  673.             IF (.NOT.(TOKTYP.EQ.TRPARN .OR. TOKTYP.EQ.TNAME .OR.
  674.      +           TOKTYP.EQ.TDCNST .OR. TOKTYP.EQ.TRCNST .OR.
  675.      +           TOKTYP.EQ.TPCNST) .AND. NXTTYP.EQ.TPLUS) THEN
  676.                 NXTTYP=TMPLUS
  677.                 NXTLEN=1
  678.                 NXTTXT(1)=43
  679.                 NXTTXT(2)=129
  680.             ELSE IF (.NOT.(TOKTYP.EQ.TRPARN .OR. TOKTYP.EQ.TNAME .OR.
  681.      +           TOKTYP.EQ.TDCNST .OR. TOKTYP.EQ.TRCNST .OR.
  682.      +           TOKTYP.EQ.TPCNST) .AND. NXTTYP.EQ.TMINUS) THEN
  683.                 NXTTYP=TMMINU
  684.                 NXTLEN=1
  685.                 NXTTXT(1)=45
  686.                 NXTTXT(2)=129
  687.             END IF
  688.         ELSE IF (LASTTK.EQ.TZEOF) THEN
  689.             CALL ERROR('Attempt To Read Past End-of-File')
  690.         END IF
  691.         IF (SEDDEL) GOTO 100
  692.  
  693.         END
  694. C ----------------------------------------------------------------------
  695. C
  696. C       C A S C V T  -  Convert case of token
  697. C
  698. C
  699.         SUBROUTINE CASCVT(TYPE,LEN,TEXT)
  700.         INTEGER TYPE,LEN,TEXT(1322)
  701.  
  702. C---------------------------------------------------------
  703. C    TOOLPACK/1    Release: 2.5
  704. C---------------------------------------------------------
  705. C
  706. C  TKLAST = LAST TOKEN NUMBER
  707. C
  708.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  709.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  710.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  711.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  712.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  713.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  714.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  715.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  716.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  717.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  718.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  719.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  720.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  721.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  722.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  723.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  724.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  725.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  726.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  727.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  728.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  729.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  730.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  731.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  732.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  733.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  734.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  735.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  736.  
  737.  
  738.         COMMON/CASE/KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
  739.         INTEGER KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
  740.  
  741.         SAVE
  742.  
  743.         INTEGER CVT,I
  744.  
  745.         INTEGER ZUPPER
  746.         EXTERNAL ZTOCAP,ZTOLOW,ZUPPER
  747.  
  748.         IF (LEN.EQ.0) THEN
  749.             IF (KWCASE.EQ.1) THEN
  750.                 CALL ZTOLOW(TEXT)
  751.             ELSE IF (KWCASE.EQ.2) THEN
  752.                 CALL ZTOLOW(TEXT(2))
  753.             END IF
  754.         ELSE IF (TYPE.EQ.TNAME .AND. IDCASE.NE.0 .OR.
  755.      +      TYPE.EQ.TCCNST .AND. STRCAS.NE.0 .OR.
  756.      +      (TYPE.EQ.TFIELD .OR. TYPE.EQ.TSCALE) .AND.
  757.      +           FFCASE.NE.0 .OR.
  758.      +      TYPE.EQ.TCMMNT .AND. CMCASE.NE.0) THEN
  759.             IF (TYPE.EQ.TNAME) CVT=IDCASE
  760.             IF (TYPE.EQ.TCCNST) CVT=STRCAS
  761.             IF (TYPE.EQ.TCMMNT) CVT=CMCASE
  762.             IF (TYPE.EQ.TFIELD .OR. TYPE.EQ.TSCALE) CVT=FFCASE
  763.             IF (CVT.EQ.1) THEN
  764.                 CALL ZTOCAP(TEXT)
  765.             ELSE IF (CVT.EQ.2) THEN
  766.                 CALL ZTOLOW(TEXT)
  767.             ELSE IF (CVT.EQ.3) THEN
  768.                 CALL ZTOLOW(TEXT)
  769.                 TEXT(1)=ZUPPER(TEXT(1))
  770.             ELSE
  771. C invertcase
  772.                 DO 100 I=1,LEN
  773.                     IF (TEXT(I).GE.65 .AND. TEXT(I).LE.90) THEN
  774.                         TEXT(I)=TEXT(I)-65+97
  775.                     ELSE IF (TEXT(I).GE.97 .AND. TEXT(I).LE.122) THEN
  776.                         TEXT(I)=TEXT(I)-97+65
  777.                     END IF
  778.  100            CONTINUE
  779.             END IF
  780.         END IF
  781.  
  782.         END
  783. C ----------------------------------------------------------------------
  784. C
  785. C       P R O C M T  -  Process comment/comment-block
  786. C                       (this is not called for single-line comments)
  787. C
  788.  
  789.         SUBROUTINE PROCMT
  790.  
  791. C---------------------------------------------------------
  792. C    TOOLPACK/1    Release: 2.5
  793. C---------------------------------------------------------
  794. C
  795. C  TKLAST = LAST TOKEN NUMBER
  796. C
  797.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  798.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  799.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  800.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  801.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  802.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  803.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  804.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  805.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  806.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  807.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  808.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  809.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  810.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  811.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  812.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  813.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  814.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  815.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  816.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  817.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  818.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  819.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  820.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  821.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  822.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  823.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  824.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  825.  
  826.  
  827.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  828.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  829.      +          NXTTXT(1322)
  830.  
  831.         COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  832.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  833.  
  834.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  835.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  836.  
  837.         COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  838.         INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  839.  
  840.         COMMON/CASE/KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
  841.         INTEGER KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
  842.  
  843.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  844.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  845.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  846.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  847.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  848.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  849.      +          ,LBLTBO(500),LBLTOP
  850.         LOGICAL BEGUN,BEGCMT
  851.  
  852.         COMMON/NAME/PUNAME
  853.         CHARACTER*6 PUNAME
  854.  
  855.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  856.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  857.         LOGICAL SEQRQD
  858.  
  859.         SAVE
  860.  
  861.         INTEGER SAVIOD,LEN,BUFF(134),I,MAXLEN,L2
  862.         LOGICAL BOXING
  863.  
  864.         INTEGER ZGTCMD,ZCCTOI
  865.         EXTERNAL SEEK,ZGTCMD,ZPTMES,ZCCTOI
  866.  
  867.         BOXING=CBOX.GT.0 .AND. NXTTYP.EQ.TCMMNT .AND. TOKLEN.GT.0 .AND.
  868.      +         NXTLEN.GT.0
  869.         IF (BOXING .OR. SEQRQD .AND. .NOT. BEGUN) THEN
  870.             BEGCMT=SEQRQD .AND. .NOT. BEGUN
  871.             SAVIOD=IODCUR
  872.             IODCUR=IODSCR
  873.             CALL SEEK(0,IODSCR)
  874. C Output the first line of the comment twice for a whole box, so that we have
  875. C a chance to get the sequence numbering right (for a change!)
  876.             IF (CBOX.EQ.2 .AND. SEQRQD) CALL OUTCMT
  877.  100        CALL OUTCMT
  878.             IF (NXTTYP.EQ.TCMMNT .AND. (NXTLEN.GT.0 .OR. BEGCMT)) THEN
  879.                 CALL RDTOK
  880.                 GOTO 100
  881.             END IF
  882.             IODCUR=SAVIOD
  883.             IF (BEGCMT) RETURN
  884.         END IF
  885.         BOXING=BOXING .OR. BEGCMT .AND. CBOX.GT.0
  886.         IF (BOXING) THEN
  887.  
  888. C Find the maximum length of all of the comment lines in the block
  889.  
  890.             MAXLEN=0
  891.             CALL SEEK(0,IODSCR)
  892.  200        LEN=ZGTCMD(BUFF,IODSCR)
  893.             IF (LEN.NE.-100) THEN
  894.                 L2=MIN(LEN,RMARGC)
  895. C ignore trailing spaces before the sequence number
  896.  250            IF (L2.GT.1 .AND.BUFF(L2).EQ.32) THEN
  897.                     L2=L2-1
  898.                     GOTO 250
  899.                 END IF
  900.                 IF (L2.GT.MAXLEN) MAXLEN=L2
  901.                 GOTO 200
  902.             END IF
  903.         ELSE IF (BEGCMT) THEN
  904.             MAXLEN=0
  905.         END IF
  906.  
  907. C If not enough room for the box, just spew it all back out to IODCUR
  908. C ...ditto if no actual comment test (but no error message).
  909. C ...ditto if unboxed comment at beginning of program unit.
  910.  
  911.         IF (BOXING .OR. BEGCMT) THEN
  912.             IF (MAXLEN.GT.RMARGC-CBOX*2)
  913.      +          CALL PLERR('Comment box exceeds RMARGC - Not added')
  914.             IF (MAXLEN.GT.RMARGC-CBOX*2 .OR. MAXLEN.LE.LMARGC) THEN
  915.                 IF (CBOX.EQ.2 .AND. SEQRQD)
  916.      +              CALL PLERR('First line of failed box duplicated')
  917.                 CALL SEEK(0,IODSCR)
  918.  300            LEN=ZGTCMD(BUFF,IODSCR)
  919.                 IF (LEN.NE.-100) THEN
  920.                     IF (BEGCMT) THEN
  921.                         DO 350 I=1,4
  922.  350                        BUFF(72+I)=ZCCTOI(PUNAME(I:I),BUFF(72+I))
  923.                     END IF
  924.                     CALL ZPTMES(BUFF,IODCUR)
  925.                     GOTO 300
  926.                 END IF
  927.                 BEGCMT=.FALSE.
  928.                 RETURN
  929.             END IF
  930.  
  931. C If we want a whole box, put the top in
  932.  
  933.             IF (CBOX.EQ.2) THEN
  934.                 IF (SEQRQD) THEN
  935.                     CALL SEEK(0,IODSCR)
  936.                     LEN=ZGTCMD(BUFF,IODSCR)
  937.                 END IF
  938.                 IF (CMCHAR.EQ.32) THEN
  939.                     BUFF(1)=67
  940.                     IF (CMCASE.EQ.2) BUFF(1)=99
  941.                 ELSE
  942.                     BUFF(1)=CMCHAR
  943.                 END IF
  944.                 DO 400 I=2,LMARGC-1
  945.  400                BUFF(I)=32
  946.                 DO 500 I=LMARGC,MAXLEN+CBOX*2
  947.  500                BUFF(I)=CBTOP
  948.                 IF (BEGCMT) THEN
  949.                     DO 550 I=1,4
  950.  550                    BUFF(72+I)=ZCCTOI(PUNAME(I:I),BUFF(72+I))
  951.                 ELSE IF (.NOT. SEQRQD) THEN
  952.                     BUFF(MAXLEN+CBOX*2+1)=129
  953.                 END IF
  954.                 CALL ZPTMES(BUFF,IODCUR)
  955.             END IF
  956.  
  957. C Now do the body of the box
  958.  
  959.             IF (CBOX.NE.2 .OR. .NOT. SEQRQD) CALL SEEK(0,IODSCR)
  960.  600        LEN=ZGTCMD(BUFF,IODSCR)
  961.             IF (LEN.NE.-100) THEN
  962.                 DO 700 I=LEN+1,LMARGC,-1
  963.  700                BUFF(I+2)=BUFF(I)
  964. C Don't mess up sequence numbers
  965.                 IF (SEQRQD) THEN
  966.                     DO 715 I=73,81
  967.  715                    BUFF(I)=BUFF(I+2)
  968.                 END IF
  969.                 IF (LEN.LT.LMARGC) THEN
  970.                     DO 725 I=2,LMARGC
  971.  725                    BUFF(I)=32
  972.                     LEN=LMARGC-1
  973.                 END IF
  974.                 BUFF(LMARGC)=CBSIDE
  975.                 BUFF(LMARGC+1)=32
  976.                 IF (CBOX.EQ.2) THEN
  977.                     DO 750 I=LEN+3,MAXLEN+3
  978.  750                    BUFF(I)=32
  979.                     BUFF(MAXLEN+4)=CBSIDE
  980.                     IF (.NOT. SEQRQD) BUFF(MAXLEN+5)=129
  981.                 END IF
  982.                 IF (BEGCMT) THEN
  983.                     DO 775 I=1,4
  984.  775                    BUFF(72+I)=ZCCTOI(PUNAME(I:I),BUFF(72+I))
  985.                 END IF
  986.                 CALL ZPTMES(BUFF,IODCUR)
  987.                 GOTO 600
  988.             END IF
  989.  
  990. C And finally the bottom of the box
  991.  
  992.             IF (CMCHAR.EQ.32) THEN
  993.                 BUFF(1)=67
  994.             ELSE
  995.                 BUFF(1)=CMCHAR
  996.             END IF
  997.             DO 800 I=2,LMARGC-1
  998.  800            BUFF(I)=32
  999.             DO 900 I=LMARGC,MAXLEN+CBOX*2
  1000.  900            BUFF(I)=CBTOP
  1001.             IF (SEQRQD) CALL ADDSEQ(BUFF,MAXLEN+CBOX*2+1)
  1002.             LNUMBR=LNUMBR+1
  1003.             CALL ZPTMES(BUFF,IODCUR)
  1004.             BEGCMT=.FALSE.
  1005.  
  1006. C Otherwise (no funny stuff) just output the comment
  1007.  
  1008.         ELSE
  1009.             CALL OUTCMT
  1010.         END IF
  1011.  
  1012.         END
  1013. C ----------------------------------------------------------------------
  1014. C
  1015. C       A D D S E Q   -   Add a sequence number to a line
  1016. C
  1017.  
  1018.         SUBROUTINE ADDSEQ(LINE,CURSOR)
  1019.         INTEGER LINE(*),CURSOR
  1020.  
  1021.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1022.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1023.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1024.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1025.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1026.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1027.      +          ,LBLTBO(500),LBLTOP
  1028.         LOGICAL BEGUN,BEGCMT
  1029.  
  1030.         COMMON/NAME/PUNAME
  1031.         CHARACTER*6 PUNAME
  1032.  
  1033.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  1034.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  1035.         LOGICAL SEQRQD
  1036.  
  1037.         SAVE
  1038.  
  1039.         INTEGER I,NDIG
  1040.  
  1041.         INTEGER ZCCTOI
  1042.         EXTERNAL ZCCTOI,ZITOCP
  1043.  
  1044.         I=INDEX(PUNAME,' ')
  1045.         IF (I.GT.0) THEN
  1046.             NDIG=MAX(SEQDIG,9-I)
  1047.         ELSE
  1048.             NDIG=SEQDIG
  1049.         END IF
  1050.         DO 100 I=CURSOR,72
  1051.  100        LINE(I)=32
  1052.         DO 200 I=1,MIN(6,8-NDIG)
  1053.  200        LINE(72+I)=ZCCTOI(PUNAME(I:I),LINE(72+I))
  1054.         DO 300 I=7,8-NDIG
  1055.  300        LINE(72+I)=32
  1056.         CALL ZITOCP(LNUMBR,LINE(81-NDIG),NDIG,SEQFIL)
  1057.         LINE(81)=129
  1058.  
  1059.         END
  1060. C ----------------------------------------------------------------------
  1061. C
  1062. C       P R O E N D  -  Process END (of program-unit)
  1063. C
  1064.  
  1065.         SUBROUTINE PROEND
  1066.  
  1067. C---------------------------------------------------------
  1068. C    TOOLPACK/1    Release: 2.5
  1069. C---------------------------------------------------------
  1070. C
  1071. C  TKLAST = LAST TOKEN NUMBER
  1072. C
  1073.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1074.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1075.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1076.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1077.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1078.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1079.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1080.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1081.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1082.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1083.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1084.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1085.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1086.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1087.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1088.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1089.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1090.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1091.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1092.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1093.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1094.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1095.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1096.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1097.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1098.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1099.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1100.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1101.  
  1102.  
  1103.         COMMON/OUTLIN/LINE,CURSOR
  1104.         INTEGER LINE(134),CURSOR
  1105.  
  1106.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  1107.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  1108.  
  1109.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1110.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1111.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1112.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1113.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1114.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1115.      +          ,LBLTBO(500),LBLTOP
  1116.         LOGICAL BEGUN,BEGCMT
  1117.  
  1118.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  1119.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  1120.         LOGICAL BLADEC
  1121.  
  1122.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  1123.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  1124.         LOGICAL SEQRQD
  1125.  
  1126.         COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  1127.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  1128.  
  1129.         COMMON/MOVFMT/MOVEF,MFFLAG
  1130.         LOGICAL MOVEF,MFFLAG
  1131.  
  1132.         COMMON/NAME/PUNAME
  1133.         CHARACTER*6 PUNAME
  1134.  
  1135.         COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
  1136.         LOGICAL DOCONI,IOTHCO
  1137.         INTEGER NDOCON,DOCONS(30)
  1138.  
  1139.         COMMON/DECLUP/DLUP,DLEN,DLUPOS
  1140.         LOGICAL DLUP
  1141.         INTEGER DLEN,DLUPOS
  1142.  
  1143.         SAVE
  1144.  
  1145.         INTEGER LINLEN,BUFF(134)
  1146.  
  1147.         INTEGER GETLIN
  1148.         EXTERNAL GETLIN,PUTLIN,SEEK,ZITOCP
  1149.  
  1150.         IF (.NOT. BEGUN) THEN
  1151.             BEGUN=.TRUE.
  1152.             PUNAME='MAIN'
  1153.             IF (BEGCMT) CALL PROCMT
  1154.         END IF
  1155.  
  1156. C Output blank line following previous statement if required
  1157.  
  1158.         IF (BLAFT(LASTST).GT.0) CALL OUTBL
  1159.  
  1160. C Check for insertion of CONTINUE with labelled END
  1161.  
  1162.         IF (IOTHCO .AND. LABEL.GT.0) CALL OUTCON
  1163.  
  1164. C If moving FORMAT statements, output any of them now
  1165.  
  1166.         IF (MOVEF .AND. MFFLAG) THEN
  1167.             CALL SEEK(0,IODFMT)
  1168.             LINLEN=GETLIN(BUFF,IODFMT)
  1169.             IF (LINLEN.NE.-100) THEN
  1170.                 IF (BLBEF(TFORMA).GT.0 .AND. LASTST.NE.TCMMNT)CALL OUTBL
  1171.                 IF (SEQRQD) THEN
  1172.                     CALL ZITOCP(LNUMBR,BUFF(77),4,32)
  1173. C Replace newline character that ZITOCP overwrote
  1174.                     BUFF(81)=10
  1175.                 END IF
  1176.                 CALL PUTLIN(BUFF,IODCUR)
  1177.                 LNUMBR=LNUMBR+SEQINC
  1178.  100            LINLEN=GETLIN(BUFF,IODFMT)
  1179.                 IF (LINLEN.NE.-100) THEN
  1180.                     IF (SEQRQD) THEN
  1181.                         CALL ZITOCP(LNUMBR,BUFF(77),4,32)
  1182. C Replace newline character that ZITOCP overwrote
  1183.                         BUFF(81)=10
  1184.                     END IF
  1185.                     CALL PUTLIN(BUFF,IODCUR)
  1186.                     LNUMBR=LNUMBR+SEQINC
  1187.                     GOTO 100
  1188.                 END IF
  1189.             END IF
  1190.             CALL SEEK(0,IODFMT)
  1191.  
  1192. C FORMAT statement move finished
  1193.  
  1194. C If no FORMAT statement moving was done, check for blank line
  1195. C outputting before the END.
  1196.  
  1197.         ELSE IF (BLBEF(TEND).GT.0 .AND. LASTST.NE.TCMMNT) THEN
  1198.             CALL OUTBL
  1199.         END IF
  1200.  
  1201. C Process label for END statement if necessary
  1202.  
  1203.         IF (LABEL.GT.0 .AND..NOT.IOTHCO) CALL PROLBL
  1204.  
  1205.         IF (DOLVL.GT.0)
  1206.      +      CALL PLERR('DO nesting level > 0 at END of Program Unit')
  1207.         IF (IFLVL.GT.0)
  1208.      +      CALL PLERR('IF nexting level > 0 at END of Program Unit')
  1209.         IF (LBLUNK.GT.0)
  1210.      +      CALL ERROR('Undefined Labels in Program Unit')
  1211.         DOLVL=0
  1212.         IFLVL=0
  1213.         LBLUNK=0
  1214.         CURSOR=LMARGS
  1215.         CALL GRIND(TZEOS)
  1216.         CALL RDTOK
  1217.         LNUMBR=SEQINI
  1218.         PUNAME='      '
  1219.         LBLTOP=0
  1220.         FLBNUM=-1
  1221.         SLBNUM=-1
  1222.         DLUPOS=0
  1223.         MFFLAG=.FALSE.
  1224.         BEGUN=.FALSE.
  1225.  
  1226.         END
  1227. C ----------------------------------------------------------------------
  1228. C
  1229. C       P R O E O S  -  Process End-Of-Statement
  1230. C
  1231.  
  1232.         SUBROUTINE PROEOS
  1233.  
  1234.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1235.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1236.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1237.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1238.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1239.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1240.      +          ,LBLTBO(500),LBLTOP
  1241.         LOGICAL BEGUN,BEGCMT
  1242.  
  1243.         COMMON/CONTIN/CONCHR,CONCNT
  1244.         INTEGER CONCHR,CONCNT
  1245.  
  1246.         SAVE
  1247.  
  1248.         CONCOL=0
  1249.         CONCNT=0
  1250.         CALL RDTOK
  1251.  
  1252.         END
  1253. C ----------------------------------------------------------------------
  1254. C
  1255. C       L E X I S T   -   Label exists?
  1256. C
  1257.  
  1258.         LOGICAL FUNCTION LEXIST(LBL)
  1259.         INTEGER LBL
  1260.  
  1261.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1262.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1263.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1264.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1265.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1266.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1267.      +          ,LBLTBO(500),LBLTOP
  1268.         LOGICAL BEGUN,BEGCMT
  1269.  
  1270.         INTEGER I
  1271.  
  1272.         SAVE /STATE/
  1273.  
  1274.         I=0
  1275.  
  1276.  100    I=I+1
  1277.         IF (I.LT.LBLTOP .AND. LBLTBI(I).NE.LBL) GOTO 100
  1278.         LEXIST=LBLTBI(I).EQ.LBL .AND. I.LE.LBLTOP
  1279.  
  1280.         END
  1281. C ----------------------------------------------------------------------
  1282. C
  1283. C       S E T L B L   -   This routine cheats on the rest of the system.
  1284. C                         It sets the value of a label to the next label
  1285. C                         which would be output (via SLBNUM/SLBINC)  but
  1286. C                         doesn't alter anything else -- so that two
  1287. C                         virtual labels will point to the same output
  1288. C                         label; this is for when we change our mind
  1289. C                         about the target of a GOTO inside a do-loop,
  1290. C                         because we thought the do-loop was going to
  1291. C                         end on a non-CONTINUE statement, and it
  1292. C                         disappointed us.
  1293. C
  1294.  
  1295.         SUBROUTINE SETLBL(LBL)
  1296.         INTEGER LBL
  1297.  
  1298.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1299.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1300.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1301.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1302.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1303.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1304.      +          ,LBLTBO(500),LBLTOP
  1305.         LOGICAL BEGUN,BEGCMT
  1306.  
  1307.         COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
  1308.         INTEGER FLBINI,FLBINC,SLBINI,SLBINC
  1309.         LOGICAL RLBFMT,RLBSTM
  1310.  
  1311.         INTEGER I
  1312.  
  1313.         SAVE /STATE/,/RELBL/
  1314.  
  1315.         EXTERNAL ERROR
  1316.  
  1317.         I=0
  1318.  
  1319.  100    I=I+1
  1320.         IF (I.LT.LBLTOP .AND. LBLTBI(I).NE.LBL) GOTO 100
  1321.         IF (LBLTBI(I).NE.LBL) CALL ERROR('SETLBL - Internal Error')
  1322.         IF (LBLTBO(I).GT.0) CALL ERROR('SETLBL - Catastrophic Error')
  1323.         IF (SLBNUM.GT.0) THEN
  1324.             LBLTBO(I)=SLBNUM
  1325.         ELSE
  1326.             LBLTBO(I)=SLBINI
  1327.         END IF
  1328.         LBLUNK=LBLUNK-1
  1329.  
  1330.         END
  1331. C ----------------------------------------------------------------------
  1332. C
  1333. C       P R O E X E  -  Process executable statement.
  1334. C                       This actually only does all the label definition
  1335. C                       and CONTINUE insertion processing (DO-loop
  1336. C                       termination,etc.) and calls PROSTM (ie Process
  1337. C                       Statement) which does the statement proper.
  1338. C
  1339.  
  1340.         SUBROUTINE PROEXE
  1341.  
  1342. C---------------------------------------------------------
  1343. C    TOOLPACK/1    Release: 2.5
  1344. C---------------------------------------------------------
  1345. C
  1346. C  TKLAST = LAST TOKEN NUMBER
  1347. C
  1348.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1349.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1350.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1351.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1352.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1353.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1354.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1355.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1356.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1357.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1358.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1359.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1360.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1361.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1362.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1363.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1364.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1365.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1366.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1367.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1368.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1369.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1370.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1371.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1372.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1373.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1374.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1375.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1376.  
  1377.  
  1378.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  1379.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  1380.      +          NXTTXT(1322)
  1381.  
  1382.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1383.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1384.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1385.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1386.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1387.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1388.      +          ,LBLTBO(500),LBLTOP
  1389.         LOGICAL BEGUN,BEGCMT
  1390.  
  1391.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  1392.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  1393.         LOGICAL BLADEC
  1394.  
  1395.         COMMON/TYPES/ STTYPE
  1396.         INTEGER STTYPE(TKLAST)
  1397.  
  1398.         COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
  1399.         LOGICAL DOCONI,IOTHCO
  1400.         INTEGER NDOCON,DOCONS(30)
  1401.  
  1402.         COMMON/NAME/PUNAME
  1403.         CHARACTER*6 PUNAME
  1404.  
  1405.         COMMON/OPT15C/INDDOC,DELSED,BRKLIF
  1406.         LOGICAL INDDOC,DELSED,BRKLIF
  1407.  
  1408.         SAVE
  1409.  
  1410.         LOGICAL DOCIND,DOTERM
  1411.  
  1412. C Our own local logical function
  1413.         LOGICAL LEXIST
  1414.  
  1415.         DOCIND=.FALSE.
  1416.         DOTERM=.FALSE.
  1417.         IF (.NOT. BEGUN) THEN
  1418.             BEGUN=.TRUE.
  1419.             PUNAME='MAIN'
  1420.             IF (BEGCMT) CALL PROCMT
  1421.         END IF
  1422.  
  1423.         IF ((BLBEF(TOKTYP).GT.0 .AND. LASTST.NE.TCMMNT) .OR.
  1424.      +      (BLAFT(LASTST).GT.0) .OR.
  1425.      +      (STTYPE(LASTST).EQ.3 .AND. BLADEC)) CALL OUTBL
  1426.  
  1427. C Check for termination of a DO-loop
  1428.  
  1429.  100    IF (DOLVL.GT.0) THEN
  1430.             IF (DOLBL(DOLVL).EQ.LABEL) THEN
  1431. C Indent this DO-loop CONTINUE == yes iff we are doing it
  1432.                 DOCIND=INDDOC
  1433.                 IF (IOTHCO) DOTERM=.TRUE.
  1434.  
  1435. C When DOCONI ...
  1436.                 IF (DOCONI) THEN
  1437. C When DOCONI: Output real stmt first if not a CONTINUE
  1438.                     IF (TOKTYP.NE.TCONTI) THEN
  1439.                         IF (LEXIST(LABEL)) THEN
  1440.                             IF (IOTHCO) THEN
  1441.                                 CALL OUTCON
  1442.                             ELSE
  1443.                                 CALL PROLBL
  1444.                             ENDIF
  1445. C Restore value of LABEL overwritten by PROLBL
  1446.                             LABEL=DOLBL(DOLVL)
  1447.                         END IF
  1448.                         CALL PROSTM
  1449.                     ELSE IF (LEXIST(LABEL)) THEN
  1450. C ... For when we had a GOTO to it, and we want the label of the GOTO
  1451. C     to actually GOTO it, because it was a CONTINUE after all ...
  1452. C ... Call a cheating routine which sets the new value of label painlessly
  1453.                         CALL SETLBL(LABEL)
  1454.                     END IF
  1455. C When DOCONI: If multiple loop term ... output separate CONTINUE(s)
  1456.  200                IF (DOLVL.GT.1) THEN
  1457.                         IF (DOLBL(DOLVL-1).EQ.LABEL) THEN
  1458.                             LABEL=DOCONS(DOLVL)
  1459.                             IF (.NOT.DOCIND) DOLVL=DOLVL-1
  1460.                             CALL OUTCON
  1461.                             IF (DOCIND) DOLVL=DOLVL-1
  1462. C Restore value of LABEL overwritten by PROLBL (called by OUTCON)
  1463.                             LABEL=DOLBL(DOLVL+1)
  1464.                             GOTO 200
  1465.                         END IF
  1466.                     END IF
  1467. C When DOCONI: Finally, replace label with the label we desire
  1468.                     LABEL=DOCONS(DOLVL)
  1469.                     DOLVL=DOLVL-1
  1470.  
  1471. C Otherwise (not DOCONI): decrement level and check for nesting
  1472.                 ELSE
  1473.                     DOLVL=DOLVL-1
  1474.                     GOTO 100
  1475.                 END IF
  1476.             END IF
  1477.         END IF
  1478.  
  1479. C If we need to output a CONTINUE now (bacause a DO-loop didn't end on
  1480. C a CONTINUE), then do it instead of outputting the statement (which
  1481. C has been already done).
  1482.  
  1483.         IF (TOKTYP.EQ.TZEOS) THEN
  1484.             IF (DOCIND) DOLVL=DOLVL+1
  1485.             CALL OUTCON
  1486.             IF (DOCIND) DOLVL=DOLVL-1
  1487.         ELSE
  1488.  
  1489. C Here on all other happenings...
  1490. C (When IOTHCO, insert a CONTINUE *before* the current statement)
  1491.  
  1492.             IF (LABEL.NE.0) THEN
  1493.                 IF (TOKTYP.EQ.TCONTI .OR. .NOT. IOTHCO) THEN
  1494.                     IF (IOTHCO) DOTERM=.FALSE.
  1495.                     CALL PROLBL
  1496. C If this is a DO loop terminator label then do not insert CONTINUE
  1497.                 ELSE
  1498.                     IF (DOTERM) THEN
  1499.                         DOTERM=.FALSE.
  1500.                         CALL PROLBL
  1501.                     ELSE
  1502.                         IF (DOCIND) DOLVL=DOLVL+1
  1503.                         CALL OUTCON
  1504.                         IF (DOCIND) DOLVL=DOLVL-1
  1505.                     ENDIF
  1506.                 END IF
  1507.             END IF
  1508.  
  1509. C If we have just ended a DO-loop on a CONTINUE and we are supposed to
  1510. C indent the CONTINUEs as well, do it.
  1511.             IF (DOCIND .AND. TOKTYP.EQ.TCONTI) THEN
  1512.                 DOLVL=DOLVL+1
  1513.                 CALL PROSTM
  1514.                 DOLVL=DOLVL-1
  1515.             ELSE
  1516.                 CALL PROSTM
  1517.             END IF
  1518.         END IF
  1519.  
  1520.         END
  1521. C ----------------------------------------------------------------------
  1522. C
  1523. C       P R O S T M  -  Process (executable) statement.
  1524. C                       This processes the statement itself, after any
  1525. C                       label processing and CONTINUE insertion has been
  1526. C                       done by PROEXE.
  1527. C
  1528.  
  1529.         SUBROUTINE PROSTM
  1530.  
  1531. C---------------------------------------------------------
  1532. C    TOOLPACK/1    Release: 2.5
  1533. C---------------------------------------------------------
  1534. C
  1535. C  TKLAST = LAST TOKEN NUMBER
  1536. C
  1537.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1538.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1539.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1540.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1541.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1542.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1543.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1544.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1545.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1546.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1547.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1548.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1549.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1550.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1551.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1552.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1553.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1554.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1555.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1556.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1557.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1558.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1559.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1560.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1561.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1562.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1563.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1564.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1565.  
  1566.  
  1567.         COMMON/OUTLIN/LINE,CURSOR
  1568.         INTEGER LINE(134),CURSOR
  1569.  
  1570.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  1571.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  1572.  
  1573.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  1574.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  1575.      +          NXTTXT(1322)
  1576.  
  1577.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1578.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1579.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1580.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1581.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1582.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1583.      +          ,LBLTBO(500),LBLTOP
  1584.         LOGICAL BEGUN,BEGCMT
  1585.  
  1586.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  1587.         INTEGER INDDO,INDIF,INDCON,MAXIND
  1588.         LOGICAL INDCMT
  1589.  
  1590.         COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
  1591.         LOGICAL DOCONI,IOTHCO
  1592.         INTEGER NDOCON,DOCONS(30)
  1593.  
  1594.         COMMON/ASGLUP/VLEN
  1595.         INTEGER VLEN
  1596.  
  1597.         COMMON/SPACNG/SPBEF,SPAFT
  1598.         INTEGER SPBEF(-2:TKLAST,0:2),SPAFT(-2:TKLAST,0:2)
  1599.  
  1600.         COMMON/CONTIN/CONCHR,CONCNT
  1601.         INTEGER CONCHR,CONCNT
  1602.  
  1603.         SAVE
  1604.  
  1605.         INTEGER I
  1606.  
  1607.         INTEGER CTOI,ITOC
  1608.         EXTERNAL CTOI,ITOC
  1609.  
  1610.         INTRINSIC MIN,MAX
  1611.  
  1612.         CURSOR=MIN(LMARGS+IFLVL*INDIF+DOLVL*INDDO,MAXIND)
  1613.         MINBRK=(CURSOR+RMARGS)/2
  1614. 100    CONTINUE
  1615. C *** This is the point to which the logical IF statement loops back.
  1616.         IF (TOKTYP.EQ.TDO) THEN
  1617.             IF (DOLVL.EQ.30)
  1618.      +          CALL ERROR('DO loops nested too deeply')
  1619.             DOLVL=DOLVL+1
  1620.             CALL GRIND(TDCNST)
  1621.             I=1
  1622.             DOLBL(DOLVL)=CTOI(TOKTXT,I)
  1623.             IF (DOLBL(DOLVL).EQ.0) CALL PLERR('DO loop has zero label')
  1624.  
  1625. C If DOCONI (=> RLBSTM), create a new label (negative thus unique)
  1626. C In case of multiple loop termination and control-flow references.
  1627.  
  1628.             DOCONS(DOLVL)=0
  1629.             IF (DOCONI) THEN
  1630.                 NDOCON=NDOCON+1
  1631.                 DOCONS(DOLVL)=-NDOCON
  1632.                 TOKLEN=ITOC(-NDOCON,TOKTXT,8)
  1633.             END IF
  1634.  
  1635.             CALL OUTLBL
  1636.             CALL SETCON
  1637.             IF (TOKTYP.NE.TCOMMA) CURSOR=CURSOR+1
  1638.             CALL GRIND(TZEOS)
  1639.         ELSE IF (TOKTYP.EQ.TGOTO) THEN
  1640.             CALL PROGO
  1641.         ELSE IF (TOKTYP.EQ.TIF) THEN
  1642.             CALL PROIF
  1643. C If a logical IF (not another IF or GOTO) loop back to process it
  1644.             IF (TOKTYP.NE.TZEOS) GOTO 100
  1645.         ELSE IF (TOKTYP.EQ.TELSE) THEN
  1646.             IFLVL=IFLVL-1
  1647.             CURSOR=MIN(MAXIND,LMARGS+INDDO*DOLVL+INDIF*IFLVL)
  1648.             CALL GRIND1
  1649.             IFLVL=IFLVL+1
  1650.         ELSE IF (TOKTYP.EQ.TELSIF) THEN
  1651.             IFLVL=IFLVL-1
  1652.             CURSOR=MIN(MAXIND,LMARGS+INDDO*DOLVL+INDIF*IFLVL)
  1653.             CALL PROIF
  1654.         ELSE IF (TOKTYP.EQ.TENDIF) THEN
  1655.             IFLVL=IFLVL-1
  1656.             CURSOR=MIN(MAXIND,LMARGS+INDDO*DOLVL+INDIF*IFLVL)
  1657.             CALL GRIND(TZEOS)
  1658.         ELSE IF (TOKTYP.EQ.TNAME) THEN
  1659.             I=CURSOR
  1660.             CALL GRIND(TEQUAL)
  1661.             IF (CONCNT.EQ.0 .AND. VLEN.GT.0) THEN
  1662.                 CURSOR=MAX(CURSOR,I+VLEN)
  1663.                 IF (SPBEF(TEQUAL,0).GT.0) CURSOR=CURSOR+1
  1664.                 CURSOR=MIN(CURSOR,RMARGS+1)
  1665.             END IF
  1666.             CALL GRIND1
  1667.             CALL SETCON
  1668.             CALL GRIND(TZEOS)
  1669.         ELSE IF (TOKTYP.EQ.TREAD .OR. TOKTYP.EQ.TWRITE .OR.
  1670.      +           TOKTYP.EQ.TPRINT) THEN
  1671.             CALL GRIND1
  1672.             IF (TOKTYP.EQ.TDCNST) THEN
  1673.                 CALL OUTLBL
  1674.             ELSE IF (TOKTYP.EQ.TLPARN) THEN
  1675.                 CALL GRIND1
  1676.                 IF (TOKTYP.NE.TFMTKD .AND. TOKTYP.NE.TERRKD .AND.
  1677.      +              TOKTYP.NE.TENDKD) THEN
  1678.  200                CALL GRIND1
  1679.                     IF (TOKTYP.NE.TRPARN .AND. TOKTYP.NE.TCOMMA .OR.
  1680.      +                  PRNLVL.GT.1) GOTO 200
  1681.                     IF (TOKTYP.EQ.TCOMMA) CALL GRIND1
  1682.                     IF (TOKTYP.EQ.TDCNST) CALL OUTLBL
  1683.                 END IF
  1684.             END IF
  1685.             CALL GRIND(TZEOS)
  1686.         ELSE IF (TOKTYP.EQ.TASSIG) THEN
  1687.             CALL GRIND(TDCNST)
  1688.             CALL OUTLBL
  1689.             CALL GRIND(TZEOS)
  1690.         ELSE IF (TOKTYP.EQ.TCALL) THEN
  1691.             CALL GRIND(TNAME)
  1692.             CALL SETCON
  1693.             CALL GRIND1
  1694.             IF (TOKTYP.EQ.TLPARN) THEN
  1695.                 CALL GRIND1
  1696.                 CALL SETCON
  1697.             END IF
  1698.             CALL GRIND(TZEOS)
  1699.         ELSE
  1700.             CALL GRIND1
  1701.             CALL SETCON
  1702.             CALL GRIND(TZEOS)
  1703.         END IF
  1704.  
  1705.         END
  1706. C ----------------------------------------------------------------------
  1707. C
  1708. C       P R O F M T  -  Process FORMAT statement
  1709. C
  1710.  
  1711.         SUBROUTINE PROFMT
  1712.  
  1713. C---------------------------------------------------------
  1714. C    TOOLPACK/1    Release: 2.5
  1715. C---------------------------------------------------------
  1716. C
  1717. C  TKLAST = LAST TOKEN NUMBER
  1718. C
  1719.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1720.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1721.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1722.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1723.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1724.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1725.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1726.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1727.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1728.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1729.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1730.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1731.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1732.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1733.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1734.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1735.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1736.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1737.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1738.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1739.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1740.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1741.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1742.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1743.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1744.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1745.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1746.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1747.  
  1748.  
  1749.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  1750.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  1751.      +          NXTTXT(1322)
  1752.  
  1753.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1754.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1755.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1756.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1757.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1758.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1759.      +          ,LBLTBO(500),LBLTOP
  1760.         LOGICAL BEGUN,BEGCMT
  1761.  
  1762.         COMMON/OUTLIN/LINE,CURSOR
  1763.         INTEGER LINE(134),CURSOR
  1764.  
  1765.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  1766.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  1767.  
  1768.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  1769.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  1770.         LOGICAL BLADEC
  1771.  
  1772.         COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  1773.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  1774.  
  1775.         COMMON/MOVFMT/MOVEF,MFFLAG
  1776.         LOGICAL MOVEF,MFFLAG
  1777.  
  1778.         COMMON/NAME/PUNAME
  1779.         CHARACTER*6 PUNAME
  1780.  
  1781.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  1782.         INTEGER INDDO,INDIF,INDCON,MAXIND
  1783.         LOGICAL INDCMT
  1784.  
  1785.         SAVE
  1786.  
  1787.         INTEGER SAVIOD
  1788.  
  1789.         IF (.NOT. BEGUN) THEN
  1790.             BEGUN=.TRUE.
  1791.             PUNAME='MAIN'
  1792.             IF (BEGCMT) CALL PROCMT
  1793.         END IF
  1794.  
  1795.         IF (LABEL.GT.0) THEN
  1796.             CALL PROLBL
  1797.         ELSE
  1798.             CALL PLERR('Unlabelled FORMAT statement')
  1799.         END IF
  1800.         IF (MOVEF) THEN
  1801.             SAVIOD=IODCUR
  1802.             IODCUR=IODFMT
  1803.             MFFLAG=.TRUE.
  1804.             CURSOR=LMARGS
  1805.         ELSE
  1806.             IF ((LASTST.NE.TFORMA .AND. LASTST.NE.TCMMNT) .AND.
  1807.      +      (BLBEF(TOKTYP).GT.0 .OR. BLAFT(LASTST).GT.0)) CALL OUTBL
  1808.             CURSOR=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,MAXIND)
  1809.         END IF
  1810.         MINBRK=(CURSOR+RMARGS)/2
  1811.         CALL GRIND(TLPARN)
  1812.         CALL SETCON
  1813.         CALL GRIND(TZEOS)
  1814.         IF (MOVEF) THEN
  1815.             IODCUR=SAVIOD
  1816.             FSTTOK=LASTST
  1817.         END IF
  1818.  
  1819.         END
  1820. C ----------------------------------------------------------------------
  1821. C
  1822. C       P R O D E C  -  Process Declaration
  1823. C
  1824.  
  1825.         SUBROUTINE PRODEC
  1826.  
  1827. C---------------------------------------------------------
  1828. C    TOOLPACK/1    Release: 2.5
  1829. C---------------------------------------------------------
  1830. C
  1831. C  TKLAST = LAST TOKEN NUMBER
  1832. C
  1833.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1834.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1835.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1836.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1837.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1838.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1839.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1840.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1841.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1842.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1843.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1844.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1845.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1846.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1847.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1848.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1849.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1850.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1851.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1852.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1853.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1854.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1855.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1856.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1857.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1858.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1859.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1860.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1861.  
  1862.  
  1863.         COMMON/OUTLIN/LINE,CURSOR
  1864.         INTEGER LINE(134),CURSOR
  1865.  
  1866.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  1867.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  1868.  
  1869.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  1870.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  1871.      +          NXTTXT(1322)
  1872.  
  1873.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  1874.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  1875.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  1876.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  1877.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  1878.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  1879.      +          ,LBLTBO(500),LBLTOP
  1880.         LOGICAL BEGUN,BEGCMT
  1881.  
  1882.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  1883.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  1884.         LOGICAL BLADEC
  1885.  
  1886.         COMMON/NAME/PUNAME
  1887.         CHARACTER*6 PUNAME
  1888.  
  1889.         COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
  1890.         LOGICAL DOCONI,IOTHCO
  1891.         INTEGER NDOCON,DOCONS(30)
  1892.  
  1893.         COMMON/DECLUP/DLUP,DLEN,DLUPOS
  1894.         LOGICAL DLUP
  1895.         INTEGER DLEN,DLUPOS
  1896.  
  1897.         COMMON/TRCOPT/TRACE
  1898.         LOGICAL TRACE
  1899.  
  1900.         SAVE
  1901.  
  1902.         EXTERNAL ZITOF,ZMESS
  1903.  
  1904.         IF (BLBEF(TOKTYP).GT.0 .AND. LASTST.NE.TCMMNT .OR.
  1905.      +      BLAFT(LASTST).GT.0) CALL OUTBL
  1906.         IF (LABEL.GT.0 .AND. .NOT. IOTHCO) CALL PROLBL
  1907.         CURSOR=LMARGS
  1908.         MINBRK=(CURSOR+RMARGS)/2
  1909. C
  1910. C First eat type part of declaration if any
  1911. C ... or eat the first keyword unless it is a program-unit header
  1912. C
  1913.         IF (TOKTYP.EQ.TINTEG .OR. TOKTYP.EQ.TREAL .OR.
  1914.      +      TOKTYP.EQ.TDOUBL .OR. TOKTYP.EQ.TLOGIC .OR.
  1915.      +      TOKTYP.EQ.TCOMPL .OR. TOKTYP.EQ.TCHARA .OR.
  1916.      +      TOKTYP.EQ.TDCMPL) THEN
  1917.             CALL GRIND1
  1918.             IF (TOKTYP.EQ.TSTAR) CALL GRIND1
  1919.             IF (TOKTYP.EQ.TLPARN) THEN
  1920. C This is where we cheat so that left-parenthesis doesn't output a
  1921. C space before it
  1922.                 LASTTK=TNAME
  1923.  100            CALL GRIND(TRPARN)
  1924.                 IF (PRNLVL.GT.1) GOTO 100
  1925.                 CALL GRIND1
  1926.                 IF (LINE(CURSOR-1).NE.32) CURSOR=CURSOR+1
  1927.             ELSE IF (TOKTYP.EQ.TDCNST) THEN
  1928.                 CALL GRIND1
  1929.                 IF (LINE(CURSOR-1).NE.32) CURSOR=CURSOR+1
  1930.             END IF
  1931.         ELSE IF (TOKTYP.NE.TPROGR .AND. TOKTYP.NE.TBLOCK .AND.
  1932.      +           TOKTYP.NE.TFUNCT .AND. TOKTYP.NE.TSUBRO) THEN
  1933.             CALL GRIND1
  1934.         END IF
  1935.         CALL SETCON
  1936. C
  1937. C Now check for program unit header
  1938. C
  1939.         IF (TOKTYP.EQ.TFUNCT .OR. TOKTYP.EQ.TSUBRO .OR. TOKTYP.EQ.TPROGR
  1940.      +      .OR. TOKTYP.EQ.TBLOCK) THEN
  1941.             IF (NXTTYP.EQ.TZEOS) THEN
  1942.                 BEGUN=.TRUE.
  1943.                 IF (BEGCMT) CALL PROCMT
  1944.             END IF
  1945.             CALL GRIND1
  1946.             IF (TOKTYP.EQ.TNAME) THEN
  1947.                 CALL ZITOF(TOKTXT,1,6,PUNAME,.FALSE.)
  1948.                 IF (TRACE) CALL ZMESS('Processing '//PUNAME,1)
  1949.                 BEGUN=.TRUE.
  1950.                 IF (BEGCMT) CALL PROCMT
  1951.                 CALL GRIND1
  1952.                 IF (TOKTYP.EQ.TLPARN) THEN
  1953.                     CALL GRIND1
  1954.                     CALL SETCON
  1955.                     IF (DLUP) DLUPOS=CURSOR
  1956.                 ELSE IF (TOKTYP.EQ.TZEOS) THEN
  1957.                     IF (DLUP) DLUPOS=DLEN+LMARGS
  1958.                 END IF
  1959.             ELSE
  1960.                 PUNAME='      '
  1961.                 IF (TRACE)
  1962.      +              CALL ZMESS('Processing BLOCK DATA',1)
  1963.             END IF
  1964. C
  1965. C Otherwise, check for funny indenting
  1966. C
  1967.         ELSE IF (DLUPOS.GT.0) THEN
  1968.             CURSOR=MAX(CURSOR,DLUPOS)
  1969.             CALL SETCON
  1970.         ELSE IF (DLEN.GT.0) THEN
  1971.             CURSOR=MAX(CURSOR,LMARGS+DLEN)
  1972.             CALL SETCON
  1973.         END IF
  1974. C
  1975. C Check for unnamed main program
  1976. C
  1977.         IF (.NOT. BEGUN) THEN
  1978.             BEGUN=.TRUE.
  1979.             PUNAME='MAIN'
  1980.             IF (BEGCMT) CALL PROCMT
  1981.         END IF
  1982. C
  1983. C Finally, do special processing for COMMON or standard processing o/w.
  1984. C
  1985.         IF (FSTTOK.EQ.TCOMMO) THEN
  1986.             CALL PROCOM
  1987.         ELSE
  1988.             CALL GRIND(TZEOS)
  1989.         END IF
  1990.  
  1991.         END
  1992. C ----------------------------------------------------------------------
  1993. C
  1994. C     C O M B L K   -   Process a common block name
  1995. C
  1996.  
  1997.       SUBROUTINE COMBLK
  1998.  
  1999. C---------------------------------------------------------
  2000. C    TOOLPACK/1    Release: 2.5
  2001. C---------------------------------------------------------
  2002. C
  2003. C  TKLAST = LAST TOKEN NUMBER
  2004. C
  2005.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2006.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2007.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2008.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2009.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2010.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2011.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2012.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2013.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2014.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2015.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2016.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2017.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2018.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2019.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2020.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2021.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2022.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2023.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2024.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2025.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2026.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2027.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2028.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2029.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2030.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2031.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2032.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2033.  
  2034.  
  2035.       COMMON/COMNAM/COMTXT
  2036.       INTEGER COMTXT(1322)
  2037.  
  2038.       COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  2039.       INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  2040.      +        NXTTXT(1322)
  2041.  
  2042.       SAVE
  2043.  
  2044.       IF (TOKTYP.EQ.TSLASH) THEN
  2045.           CALL GRIND1
  2046.           IF (TOKTYP.NE.TSLASH) THEN
  2047.               CALL SCOPY(TOKTXT,1,COMTXT,1)
  2048.           ELSE
  2049.               COMTXT(1)=129
  2050.           END IF
  2051.           CALL GRIND1
  2052.       ELSE
  2053.           COMTXT(1)=129
  2054.       END IF
  2055.  
  2056.       END
  2057. C ----------------------------------------------------------------------
  2058. C
  2059. C     P R O C O M   -   Process a COMMON statement
  2060. C
  2061.  
  2062.       SUBROUTINE PROCOM
  2063.  
  2064. C---------------------------------------------------------
  2065. C    TOOLPACK/1    Release: 2.5
  2066. C---------------------------------------------------------
  2067. C
  2068. C  TKLAST = LAST TOKEN NUMBER
  2069. C
  2070.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2071.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2072.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2073.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2074.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2075.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2076.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2077.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2078.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2079.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2080.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2081.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2082.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2083.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2084.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2085.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2086.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2087.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2088.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2089.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2090.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2091.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2092.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2093.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2094.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2095.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2096.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2097.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2098.  
  2099.  
  2100.       COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  2101.       INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  2102.      +        NXTTXT(1322)
  2103.  
  2104.       SAVE
  2105.  
  2106.       CALL COMBLK
  2107.  100  IF (TOKTYP.EQ.TSLASH) THEN
  2108.           CALL COMBLK
  2109.       ELSE
  2110.           CALL GRIND1
  2111.       END IF
  2112.       IF (TOKTYP.NE.TZEOS) GOTO 100
  2113.       CALL GRIND(TZEOS)
  2114.  
  2115.       END
  2116. C ----------------------------------------------------------------------
  2117. C
  2118. C       P R O L B L  -  Process label at beginning of line
  2119. C
  2120.  
  2121.         SUBROUTINE PROLBL
  2122.  
  2123. C---------------------------------------------------------
  2124. C    TOOLPACK/1    Release: 2.5
  2125. C---------------------------------------------------------
  2126. C
  2127. C  TKLAST = LAST TOKEN NUMBER
  2128. C
  2129.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2130.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2131.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2132.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2133.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2134.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2135.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2136.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2137.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2138.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2139.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2140.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2141.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2142.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2143.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2144.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2145.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2146.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2147.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2148.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2149.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2150.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2151.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2152.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2153.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2154.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2155.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2156.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2157.  
  2158.  
  2159.         COMMON/OUTLIN/LINE,CURSOR
  2160.         INTEGER LINE(134),CURSOR
  2161.  
  2162.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  2163.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  2164.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  2165.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  2166.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  2167.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  2168.      +          ,LBLTBO(500),LBLTOP
  2169.         LOGICAL BEGUN,BEGCMT
  2170.  
  2171.         COMMON/LFORM/LABELF,LABELC
  2172.         INTEGER LABELF,LABELC
  2173.  
  2174.         COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
  2175.         INTEGER FLBINI,FLBINC,SLBINI,SLBINC
  2176.         LOGICAL RLBFMT,RLBSTM
  2177.  
  2178.         COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  2179.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  2180.  
  2181.         INTEGER LBLPAD(2)
  2182.  
  2183.         SAVE
  2184.  
  2185.         INTEGER LENLBL,I
  2186.  
  2187.         INTEGER ITOC,CTOI
  2188.         EXTERNAL ITOC,ZITOCP,ERROR,CTOI
  2189.  
  2190.         DATA LBLPAD/32,48/
  2191.  
  2192.         IF (LABEL.EQ.0) CALL ERROR('PROLBL called with label=0')
  2193.  
  2194. C Transform label (and put into table) if relabelling
  2195.  
  2196.         IF (RLBFMT .OR. RLBSTM) THEN
  2197.             I=1
  2198.  100        IF (I.LT.LBLTOP .AND. LBLTBI(I).NE.LABEL) THEN
  2199.                 I=I+1
  2200.                 GOTO 100
  2201.             END IF
  2202.             IF (I.LE.LBLTOP .AND. LBLTBI(I).EQ.LABEL) THEN
  2203.                 IF (LBLTBO(I).GT.0) CALL ERROR('Duplicate labels')
  2204.                 LBLUNK=LBLUNK-1
  2205.             ELSE
  2206.                 IF (LBLTOP.EQ.500) CALL ERROR('Too many labels')
  2207.                 LBLTOP=LBLTOP+1
  2208.                 LBLTBI(LBLTOP)=LABEL
  2209.                 I=LBLTOP
  2210.             END IF
  2211. C Initialise SLBNUM/FLBNUM if first time
  2212.             IF (SLBNUM.LT.0) THEN
  2213.                 SLBNUM=SLBINI
  2214.                 FLBNUM=FLBINI
  2215.             END IF
  2216.             IF (FSTTOK.EQ.TFORMA .AND. RLBFMT .AND. FLBNUM.GT.0) THEN
  2217.                 LBLTBO(I)=FLBNUM
  2218.                 FLBNUM=FLBNUM+FLBINC
  2219.             ELSE IF ((FSTTOK.EQ.TFORMA .AND. RLBFMT .AND. FLBNUM.EQ.0)
  2220.      +               .OR. (FSTTOK.NE.TFORMA .AND. RLBSTM)) THEN
  2221.                 LBLTBO(I)=SLBNUM
  2222.                 SLBNUM=SLBNUM+SLBINC
  2223.             ELSE
  2224.                 LBLTBO(I)=LABEL
  2225.             END IF
  2226.             LABEL=LBLTBO(I)
  2227.             IF (LBLUNK.EQ.0 .AND. IODCUR.EQ.IODRLB) CALL XLATEL
  2228.         END IF
  2229.  
  2230. C At this point we have the (possibly new) label - format & output it
  2231.  
  2232.         IF (LABELF.EQ.0) THEN
  2233.             LENLBL=ITOC(LABEL,LINE(LABELC),7-LABELC)
  2234.             LINE(LENLBL+LABELC)=32
  2235.         ELSE
  2236.             CALL ZITOCP(LABEL,LINE(LABELC),6-LABELC,LBLPAD(LABELF))
  2237.             LINE(6)=32
  2238.         END IF
  2239.         I=1
  2240.         IF (LABEL.NE.CTOI(LINE,I)) THEN
  2241.             CALL PLERR('Label too big for requested label column')
  2242.             LENLBL=ITOC(LABEL,LINE,6)
  2243.             LINE(LENLBL+1)=32
  2244.         END IF
  2245.         CURSOR=7
  2246.  
  2247.         END
  2248. C ----------------------------------------------------------------------
  2249. C
  2250. C       X L A T E L  -  Translate labels: IODRLB -> IODPOL
  2251. C
  2252.  
  2253.         SUBROUTINE XLATEL
  2254.  
  2255.         COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  2256.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  2257.  
  2258.         COMMON/LFORM/LABELF,LABELC
  2259.         INTEGER LABELF,LABELC
  2260.  
  2261.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  2262.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  2263.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  2264.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  2265.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  2266.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  2267.      +          ,LBLTBO(500),LBLTOP
  2268.         LOGICAL BEGUN,BEGCMT
  2269.  
  2270.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  2271.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  2272.         LOGICAL SEQRQD
  2273.  
  2274.         INTEGER FLGSTR(3)
  2275.  
  2276.         SAVE
  2277.  
  2278.         INTEGER BUFF(134),STATUS,RESULT,PNTR,LBL,LBTEXT(6),LBLEN,
  2279.      +          SHIFT,I
  2280.  
  2281.         INTEGER GETLIN,ZINDEX,CTOI,ITOC,TYPE
  2282.         EXTERNAL GETLIN,PUTLIN,SEEK,ZINDEX,CTOI,ITOC,ZITOCP,TYPE
  2283.  
  2284.         DATA FLGSTR/35,35,129/
  2285.  
  2286.         IODCUR=IODPOL
  2287.         CALL SEEK(0,IODRLB)
  2288.  100    STATUS=GETLIN(BUFF,IODRLB)
  2289.         IF (STATUS.EQ.-100) RETURN
  2290.  200    RESULT=ZINDEX(BUFF,FLGSTR)
  2291.         IF (RESULT.EQ.0 .OR. TYPE(BUFF(RESULT+2)).NE.2) THEN
  2292.             CALL PUTLIN(BUFF,IODCUR)
  2293.             GOTO 100
  2294.         ELSE
  2295.             PNTR=RESULT+2
  2296.             LBL=LBLTBO(CTOI(BUFF,PNTR))
  2297.             IF (LABELF.LE.1) THEN
  2298.                 LBLEN=ITOC(LBL,LBTEXT,6)
  2299.             ELSE
  2300.                 CALL ZITOCP(LBL,LBTEXT,6-LABELC,48)
  2301.                 LBLEN=6-LABELC
  2302.             END IF
  2303.             DO 300 I=1,LBLEN
  2304.  300            BUFF(RESULT+I-1)=LBTEXT(I)
  2305.             SHIFT=PNTR-(RESULT+LBLEN)
  2306.             IF (SHIFT.GT.0) THEN
  2307.                 IF (SEQRQD) STATUS=71
  2308.                 DO 400 I=PNTR,STATUS+1
  2309.  400                BUFF(I-SHIFT)=BUFF(I)
  2310.                 STATUS=STATUS-SHIFT
  2311.                 IF (SEQRQD) THEN
  2312.                     DO 500 I=73-SHIFT,72
  2313.  500                    BUFF(I)=32
  2314.                     STATUS=80
  2315.                 END IF
  2316.             END IF
  2317.             GOTO 200
  2318.         END IF
  2319.  
  2320.         END
  2321. C ----------------------------------------------------------------------
  2322. C
  2323. C       P R O G O  -  Process a GO(TO)
  2324. C
  2325.  
  2326.         SUBROUTINE PROGO
  2327.  
  2328. C---------------------------------------------------------
  2329. C    TOOLPACK/1    Release: 2.5
  2330. C---------------------------------------------------------
  2331. C
  2332. C  TKLAST = LAST TOKEN NUMBER
  2333. C
  2334.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2335.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2336.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2337.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2338.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2339.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2340.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2341.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2342.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2343.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2344.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2345.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2346.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2347.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2348.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2349.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2350.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2351.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2352.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2353.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2354.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2355.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2356.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2357.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2358.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2359.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2360.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2361.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2362.  
  2363.  
  2364.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  2365.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  2366.      +          NXTTXT(1322)
  2367.  
  2368.         SAVE
  2369.  
  2370. C First eat the GOTO
  2371.         CALL GRIND1
  2372. C Check for the dreaded ASSIGNED GOTO (shock!, horror!!)
  2373.         IF (TOKTYP.EQ.TNAME) THEN
  2374.             CALL GRIND1
  2375.             IF (TOKTYP.NE.TZEOS) THEN
  2376.                 CALL SETCON
  2377.                 CALL GRIND(TDCNST)
  2378.                 CALL OUTLBL
  2379.             END IF
  2380.         ELSE
  2381.             IF (TOKTYP.EQ.TLPARN) THEN
  2382.                 CALL GRIND1
  2383.                 CALL SETCON
  2384.             END IF
  2385.             CALL OUTLBL
  2386.         END IF
  2387.  100    IF (TOKTYP.EQ.TCOMMA) THEN
  2388.             CALL GRIND(TDCNST)
  2389.             CALL OUTLBL
  2390.             GOTO 100
  2391.         END IF
  2392.         CALL GRIND(TZEOS)
  2393.  
  2394.         END
  2395. C ----------------------------------------------------------------------
  2396. C
  2397. C       P R O I F  -  Process an IF statement
  2398. C
  2399.  
  2400.         SUBROUTINE PROIF
  2401.  
  2402. C---------------------------------------------------------
  2403. C    TOOLPACK/1    Release: 2.5
  2404. C---------------------------------------------------------
  2405. C
  2406. C  TKLAST = LAST TOKEN NUMBER
  2407. C
  2408.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2409.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2410.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2411.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2412.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2413.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2414.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2415.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2416.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2417.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2418.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2419.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2420.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2421.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2422.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2423.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2424.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2425.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2426.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2427.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2428.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2429.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2430.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2431.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2432.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2433.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2434.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2435.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2436.  
  2437.  
  2438.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  2439.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  2440.      +          NXTTXT(1322)
  2441.  
  2442.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  2443.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  2444.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  2445.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  2446.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  2447.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  2448.      +          ,LBLTBO(500),LBLTOP
  2449.         LOGICAL BEGUN,BEGCMT
  2450.  
  2451.         COMMON/CONTIN/CONCHR,CONCNT
  2452.         INTEGER CONCHR,CONCNT
  2453.  
  2454.         COMMON/OPT15C/INDDOC,DELSED,BRKLIF
  2455.         LOGICAL INDDOC,DELSED,BRKLIF
  2456.  
  2457.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  2458.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  2459.  
  2460.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  2461.         INTEGER INDDO,INDIF,INDCON,MAXIND
  2462.         LOGICAL INDCMT
  2463.  
  2464.         SAVE
  2465.  
  2466.         CALL GRIND(TLPARN)
  2467.         CALL GRIND1
  2468.         CALL SETCON
  2469.  100    CALL GRIND(TRPARN)
  2470.         IF (PRNLVL.GT.1) GOTO 100
  2471.         CALL GRIND1
  2472. C Must check for the rather different Arithmetic IF
  2473.         IF (TOKTYP.EQ.TDCNST) THEN
  2474.  200        CALL OUTLBL
  2475.             IF (TOKTYP.EQ.TCOMMA) THEN
  2476.                 CALL GRIND1
  2477.                 GOTO 200
  2478.             END IF
  2479. C And now for the dubious Logical IF
  2480.         ELSE IF (TOKTYP.NE.TTHEN) THEN
  2481.             IF (BRKLIF .AND. CONCNT.EQ.0) THEN
  2482.                 CONCOL=MIN(LMARGS+DOLVL*INDDO+INDIF*(IFLVL+1),MAXIND)
  2483.                 CALL BREAK
  2484.             END IF
  2485. C An Arithmetic IF is allowed on the end of a Logical IF
  2486.             IF (TOKTYP.EQ.TIF) GOTO 100
  2487. C A GOTO is allowed on the end of a Logical IF
  2488.             IF (TOKTYP.EQ.TGOTO) CALL PROGO
  2489. C Otherwise:Must be a block IF, hooray
  2490.         ELSE
  2491.             IFLVL=IFLVL+1
  2492.             CALL GRIND(TZEOS)
  2493.         END IF
  2494.  
  2495.         END
  2496. C ----------------------------------------------------------------------
  2497. C
  2498. C       O U T L B L  -  Output a label token (inside a statement)
  2499. C
  2500.  
  2501.         SUBROUTINE OUTLBL
  2502.  
  2503.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  2504.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  2505.      +          NXTTXT(1322)
  2506.  
  2507.         COMMON/LFORM/LABELF,LABELC
  2508.         INTEGER LABELF,LABELC
  2509.  
  2510.         COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
  2511.         INTEGER FLBINI,FLBINC,SLBINI,SLBINC
  2512.         LOGICAL RLBFMT,RLBSTM
  2513.  
  2514.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  2515.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  2516.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  2517.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  2518.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  2519.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  2520.      +          ,LBLTBO(500),LBLTOP
  2521.         LOGICAL BEGUN,BEGCMT
  2522.  
  2523.         COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  2524.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  2525.  
  2526.         SAVE
  2527.  
  2528.         INTEGER I,LBL,LENLBL
  2529.  
  2530.         INTEGER ITOC,ZSCTOI
  2531.         EXTERNAL ITOC,ZITOCP,ZSCTOI,SEEK
  2532.  
  2533.         I=1
  2534.         LBL=ZSCTOI(TOKTXT,I)
  2535.         IF (RLBSTM .OR. RLBFMT) THEN
  2536.             I=1
  2537.  100        IF (I.LT.LBLTOP .AND. LBLTBI(I).NE.LBL) THEN
  2538.                 I=I+1
  2539.                 GOTO 100
  2540.             END IF
  2541.             IF (I.LE.LBLTOP .AND. LBLTBI(I).EQ.LBL) THEN
  2542.                 LBL=LBLTBO(I)
  2543.             ELSE
  2544.                 LBLUNK=LBLUNK+1
  2545.                 IF (IODPOL.EQ.IODCUR) THEN
  2546.                     IODCUR=IODRLB
  2547.                     CALL SEEK(0,IODRLB)
  2548.                 END IF
  2549.                 IF (LBLTOP.EQ.500) CALL ERROR('Too many labels')
  2550.                 LBLTOP=LBLTOP+1
  2551.                 LBLTBI(LBLTOP)=LBL
  2552.                 LBLTBO(LBLTOP)=-LBLTOP
  2553.                 LBL=-LBLTOP
  2554.             END IF
  2555.         END IF
  2556.         IF (LBL.LT.0) THEN
  2557.             TOKLEN=5
  2558.             CALL ZITOCP(-LBL,TOKTXT(3),3,48)
  2559.             TOKTXT(1)=35
  2560.             TOKTXT(2)=35
  2561.         ELSE IF (LABELF.LE.1) THEN
  2562.             TOKLEN=ITOC(LBL,TOKTXT,6)
  2563.         ELSE
  2564.             CALL ZITOCP(LBL,TOKTXT,6-LABELC,48)
  2565.             TOKLEN=6-LABELC
  2566.         END IF
  2567.         CALL GRIND1
  2568.  
  2569.         END
  2570. C ----------------------------------------------------------------------
  2571. C
  2572. C       G R I N D  -  Grind the tokens to make the source
  2573. C
  2574.  
  2575.         SUBROUTINE GRIND(ENDTOK)
  2576.         INTEGER ENDTOK
  2577.  
  2578. C---------------------------------------------------------
  2579. C    TOOLPACK/1    Release: 2.5
  2580. C---------------------------------------------------------
  2581. C
  2582. C  TKLAST = LAST TOKEN NUMBER
  2583. C
  2584.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2585.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2586.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2587.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2588.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2589.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2590.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2591.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2592.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2593.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2594.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2595.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2596.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2597.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2598.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2599.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2600.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2601.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2602.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2603.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2604.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2605.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2606.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2607.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2608.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2609.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2610.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2611.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2612.  
  2613.  
  2614.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  2615.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  2616.      +          NXTTXT(1322)
  2617.  
  2618.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  2619.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  2620.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  2621.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  2622.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  2623.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  2624.      +          ,LBLTBO(500),LBLTOP
  2625.         LOGICAL BEGUN,BEGCMT
  2626.  
  2627.         SAVE
  2628.  
  2629. C -- Local 2-token lookback, for END=label passed as TENDKD+TEQUAL+TDCNST
  2630.         INTEGER PREVTK
  2631.  
  2632.         PREVTK=0
  2633.  100    IF (TOKTYP.EQ.TCMMNT) THEN
  2634.             CALL CONLIN
  2635.  200        CALL OUTCMT
  2636.             PREVTK=LASTTK
  2637.             CALL RDTOK
  2638.             IF (TOKTYP.EQ.TCMMNT) GOTO 200
  2639.         ELSE IF (TOKTYP.EQ.TZEOS) THEN
  2640.             RETURN
  2641.         ELSE
  2642. C Handle label detection: FMT= & END= & ERR=
  2643.             IF ((((PREVTK.EQ.TFMTKD .OR. PREVTK.EQ.TERRKD .OR.
  2644.      +              PREVTK.EQ.TENDKD) .AND. LASTTK.EQ.TEQUAL) .OR.
  2645. C Label detection: also: "(*label" & ",*label" inside a CALL statement
  2646.      +          ((PREVTK.EQ.TLPARN .OR. PREVTK.EQ.TCOMMA) .AND.
  2647.      +              FSTTOK.EQ.TCALL .AND. LASTTK.EQ.TSTAR))
  2648.      +          .AND. TOKTYP.EQ.TDCNST) THEN
  2649.                 PREVTK=LASTTK
  2650.                 CALL OUTLBL
  2651.             ELSE
  2652.                 CALL OUTTOK
  2653.                 IF (TOKTYP.EQ.TLPARN) PRNLVL=PRNLVL+1
  2654.                 IF (TOKTYP.EQ.TRPARN) PRNLVL=PRNLVL-1
  2655.                 PREVTK=LASTTK
  2656.                 CALL RDTOK
  2657.             END IF
  2658.         END IF
  2659.         IF (TOKTYP.EQ.TZEOS) THEN
  2660.             IF (PRNLVL.NE.0) CALL PLERR('Unbalanced parentheses')
  2661.             IF (ENDTOK.NE.TZEOS) CALL PLERR('Unexpected <TZEOS>')
  2662.             CALL OUTPUT
  2663.             RETURN
  2664.         END IF
  2665.         IF (TOKTYP.NE.ENDTOK) GOTO 100
  2666.  
  2667.         END
  2668. C ----------------------------------------------------------------------
  2669. C
  2670. C       G R I N D 1  -  Grind the current token & step to the next one
  2671. C
  2672.  
  2673.         SUBROUTINE GRIND1
  2674.  
  2675. C---------------------------------------------------------
  2676. C    TOOLPACK/1    Release: 2.5
  2677. C---------------------------------------------------------
  2678. C
  2679. C  TKLAST = LAST TOKEN NUMBER
  2680. C
  2681.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2682.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2683.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2684.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2685.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2686.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2687.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2688.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2689.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2690.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2691.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2692.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2693.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2694.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2695.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2696.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2697.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2698.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2699.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2700.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2701.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2702.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2703.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2704.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2705.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2706.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2707.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2708.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2709.  
  2710.  
  2711.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  2712.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  2713.      +          NXTTXT(1322)
  2714.  
  2715.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  2716.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  2717.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  2718.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  2719.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  2720.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  2721.      +          ,LBLTBO(500),LBLTOP
  2722.         LOGICAL BEGUN,BEGCMT
  2723.  
  2724.         SAVE
  2725.  
  2726.         IF (TOKTYP.EQ.TZEOS) THEN
  2727.             CALL PLERR('Internal Error (GRIND1) - TZEOS confusion')
  2728.             RETURN
  2729.         END IF
  2730.         CALL OUTTOK
  2731.         IF (TOKTYP.EQ.TRPARN) PRNLVL=PRNLVL-1
  2732.         IF (TOKTYP.EQ.TLPARN) PRNLVL=PRNLVL+1
  2733.         CALL RDTOK
  2734.         IF (TOKTYP.EQ.TCMMNT) THEN
  2735.             CALL CONLIN
  2736.  100        CALL OUTCMT
  2737.             CALL RDTOK
  2738.             IF (TOKTYP.EQ.TCMMNT) GOTO 100
  2739.         END IF
  2740.         IF (TOKTYP.EQ.TZEOS) THEN
  2741.             IF (PRNLVL.NE.0) CALL PLERR('Unbalanced parentheses')
  2742.             CALL OUTPUT
  2743.         END IF
  2744.  
  2745.         END
  2746. C ======================================================================
  2747. C
  2748. C       T H E     P O L I S H     V I R T U A L     M A C H I N E
  2749. C
  2750. C ======================================================================
  2751.  
  2752. C ----------------------------------------------------------------------
  2753. C
  2754. C       O U T P U T  -  Output the assembled line and clear the buffer
  2755. C
  2756.  
  2757.         SUBROUTINE OUTPUT
  2758.  
  2759.         COMMON/OUTLIN/LINE,CURSOR
  2760.         INTEGER LINE(134),CURSOR
  2761.  
  2762.         COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  2763.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  2764.  
  2765.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  2766.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  2767.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  2768.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  2769.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  2770.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  2771.      +          ,LBLTBO(500),LBLTOP
  2772.         LOGICAL BEGUN,BEGCMT
  2773.  
  2774.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  2775.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  2776.         LOGICAL SEQRQD
  2777.  
  2778.         SAVE
  2779.  
  2780.         INTEGER I
  2781.  
  2782.         EXTERNAL ZPTMES
  2783.  
  2784.   50    IF (CURSOR.GT.1) THEN
  2785.             IF (LINE(CURSOR-1).EQ.32) THEN
  2786.                 CURSOR=CURSOR-1
  2787.                 GOTO 50
  2788.             END IF
  2789.         END IF
  2790.         IF (SEQRQD .AND. CURSOR.GT.73) THEN
  2791.             CALL PLERR('Line too long for Sequence Number')
  2792.         ELSE IF (SEQRQD) THEN
  2793.             CALL ADDSEQ(LINE,CURSOR)
  2794.             CURSOR=81
  2795.         END IF
  2796.         LINE(CURSOR)=129
  2797.         CALL ZPTMES(LINE,IODCUR)
  2798.         DO 100 I=1,132
  2799.  100        LINE(I)=32
  2800.         LINE(132+1)=129
  2801.         IF (IODCUR.NE.IODFMT) LNUMBR=LNUMBR+SEQINC
  2802.         CURSOR=1
  2803.         BRKPOS=0
  2804.         BRKPRI=0
  2805.  
  2806.         END
  2807. C ----------------------------------------------------------------------
  2808. C
  2809. C       O U T T O K  -  Output the current token to the line buffer
  2810. C
  2811.  
  2812.         SUBROUTINE OUTTOK
  2813.  
  2814. C---------------------------------------------------------
  2815. C    TOOLPACK/1    Release: 2.5
  2816. C---------------------------------------------------------
  2817. C
  2818. C  TKLAST = LAST TOKEN NUMBER
  2819. C
  2820.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2821.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2822.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2823.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2824.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2825.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2826.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2827.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2828.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2829.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2830.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2831.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2832.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2833.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2834.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2835.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2836.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2837.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2838.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2839.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2840.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2841.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2842.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2843.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2844.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2845.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2846.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2847.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2848.  
  2849.  
  2850.         COMMON/TOKEN/ TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  2851.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  2852.      +          NXTTXT(1322)
  2853.  
  2854.         COMMON/OUTLIN/LINE,CURSOR
  2855.         INTEGER LINE(134),CURSOR
  2856.  
  2857.         COMMON/SPACNG/SPBEF,SPAFT
  2858.         INTEGER SPBEF(-2:TKLAST,0:2),SPAFT(-2:TKLAST,0:2)
  2859.  
  2860.         COMMON/STATE/ LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  2861.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  2862.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  2863.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  2864.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  2865.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  2866.      +          ,LBLTBO(500),LBLTOP
  2867.         LOGICAL BEGUN,BEGCMT
  2868.  
  2869.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  2870.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  2871.  
  2872.         COMMON/INTBRK/BRPRIO
  2873.         INTEGER BRPRIO(-2:TKLAST,0:2)
  2874.  
  2875.         COMMON/CVTOPT/CVTHFM,FMSBRK
  2876.         LOGICAL CVTHFM,FMSBRK
  2877.  
  2878.         INTEGER I,SPACEB,SPACEA,PRNIDX,TMP,TLEN
  2879.         LOGICAL OQUOTE
  2880.  
  2881.         SAVE/TOKEN/,/OUTLIN/,/SPACNG/,/STATE/,/MARGIN/,/INTBRK/,/CVTOPT/
  2882.  
  2883.         EXTERNAL SCOPY,SKIPBL
  2884.  
  2885. C Token spacing
  2886.  
  2887.         PRNIDX=PRNLVL
  2888.         IF (PRNIDX.GT.2) PRNIDX=2
  2889.         IF (PRNIDX.LT.0) PRNIDX=0
  2890.         SPACEB=SPBEF(TOKTYP,PRNIDX)
  2891.         SPACEA=SPAFT(TOKTYP,PRNIDX)
  2892.         IF (SPACEB.EQ.-1) THEN
  2893.             SPACEB=1
  2894.             IF (LASTTK.EQ.TNAME .OR. LASTTK.EQ.TLPARN) SPACEB=0
  2895.         ELSEIF (SPACEB.EQ.-2) THEN
  2896.             CALL PLERR('Wrong paren level for token')
  2897.         ENDIF
  2898.         IF (SPACEB.GT.0 .AND. LINE(CURSOR-1).EQ.32) SPACEB=SPACEB-1
  2899.         IF (SPACEA.EQ.-1) THEN
  2900.             SPACEA=1
  2901.             IF (NXTTYP.EQ.TRPARN .OR. NXTTYP.EQ.TCOMMA) SPACEA=0
  2902. C TLE..TCNCAT  =  all operators bar assignment
  2903.             IF (NXTTYP.GE.TLE .AND. NXTTYP.LE.TCNCAT .OR.
  2904.      +          NXTTYP.EQ.TEQUAL) SPACEA=0
  2905.         ELSE IF (SPACEA.EQ.-3) THEN
  2906.             IF (NXTTYP.EQ.TSTAR) THEN
  2907.                 SPACEA=0
  2908.             ELSE
  2909.                 SPACEA=1
  2910.             END IF
  2911.         END IF
  2912.  100    IF (FSTTOK.EQ.TFORMA .AND. TOKTYP.EQ.TCCNST .AND.
  2913.      +      SPACEB+TOKLEN+CURSOR-1.GT.RMARGS .AND.
  2914.      +      TOKLEN.GT.4 .AND. FMSBRK) THEN
  2915. C Long string inside FORMAT - break it and put a comma between.
  2916.             SPACEA=MAX(SPACEA,SPBEF(TCOMMA,PRNIDX))
  2917.             TLEN=RMARGS-CURSOR-SPACEB-SPACEA
  2918.             IF (TLEN.LT.4) GOTO 300
  2919.             IF (TOKTXT(TLEN).EQ.39) THEN
  2920.                 OQUOTE=.TRUE.
  2921.                 I=TLEN-1
  2922.  200            IF (TOKTXT(I).EQ.39) OQUOTE=.NOT.OQUOTE
  2923.                 I=I-1
  2924.                 IF (I.GE.1) GOTO 200
  2925.                 IF (OQUOTE) TLEN=TLEN-1
  2926.             END IF
  2927.             IF (TLEN.LT.4) GOTO 300
  2928.             TMP=TOKTXT(TLEN)
  2929.             TOKTXT(TLEN)=129
  2930.             CURSOR=CURSOR+SPACEB
  2931.             CALL SCOPY(TOKTXT,1,LINE,CURSOR)
  2932.             CURSOR=CURSOR+TLEN-1
  2933.             LINE(CURSOR)=39
  2934.             CURSOR=CURSOR+1+SPACEA
  2935.             LINE(CURSOR)=44
  2936.             CURSOR=CURSOR+1
  2937.             TOKTXT(TLEN)=TMP
  2938.             CALL SCOPY(TOKTXT,TLEN,TOKTXT,2)
  2939.             TOKLEN=TOKLEN-(TLEN-2)
  2940.             CALL CONLIN
  2941.             SPACEA=SPAFT(TCCNST,PRNIDX)
  2942.             GOTO 100
  2943.         END IF
  2944.  300    IF (SPACEB+TOKLEN+CURSOR-1.GT.RMARGS) THEN
  2945.             CALL BREAK
  2946. C Preserve spacing (if room on line and other tokens preceding...)
  2947.             IF (SPACEB+TOKLEN+CURSOR-1.LE.RMARGS) THEN
  2948.                 I=7
  2949.                 CALL SKIPBL(LINE,I)
  2950.                 IF (LINE(I).NE.32) CURSOR=CURSOR+SPACEB
  2951.             END IF
  2952.         ELSE
  2953.             CURSOR=CURSOR+SPACEB
  2954.         END IF
  2955.         CALL SCOPY(TOKTXT,1,LINE,CURSOR)
  2956. C erase spurious eos
  2957.         LINE(CURSOR+TOKLEN)=32
  2958.         CURSOR=CURSOR+TOKLEN+SPACEA
  2959.         IF (BRPRIO(TOKTYP,PRNIDX).GE.BRKPRI .AND. CURSOR.GE.MINBRK) THEN
  2960.             BRKPOS=CURSOR
  2961.             BRKPRI=BRPRIO(TOKTYP,PRNIDX)
  2962.         END IF
  2963.  
  2964.         END
  2965. C ----------------------------------------------------------------------
  2966. C
  2967. C       O U T C M T  -  Output the current (comment) token, preserving
  2968. C                       the currently partially assembled line buffer.
  2969. C
  2970.  
  2971.         SUBROUTINE OUTCMT
  2972.  
  2973. C---------------------------------------------------------
  2974. C    TOOLPACK/1    Release: 2.5
  2975. C---------------------------------------------------------
  2976. C
  2977. C  TKLAST = LAST TOKEN NUMBER
  2978. C
  2979.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2980.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2981.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2982.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2983.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2984.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2985.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2986.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2987.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2988.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2989.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2990.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2991.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2992.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2993.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2994.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2995.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2996.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2997.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2998.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2999.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  3000.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  3001.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  3002.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  3003.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  3004.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  3005.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  3006.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  3007.  
  3008.  
  3009.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  3010.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  3011.      +          NXTTXT(1322)
  3012.  
  3013.         COMMON/STATE/ LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  3014.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  3015.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  3016.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  3017.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  3018.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  3019.      +          ,LBLTBO(500),LBLTOP
  3020.         LOGICAL BEGUN,BEGCMT
  3021.  
  3022.         COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  3023.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  3024.  
  3025.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  3026.         INTEGER INDDO,INDIF,INDCON,MAXIND
  3027.         LOGICAL INDCMT
  3028.  
  3029.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  3030.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  3031.  
  3032.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  3033.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  3034.         LOGICAL SEQRQD
  3035.  
  3036.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  3037.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  3038.         LOGICAL BLADEC
  3039.  
  3040.         COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  3041.         INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  3042.  
  3043.         SAVE
  3044.  
  3045.         INTEGER BUFF(134),POS,I,START,CMTLEN
  3046.  
  3047.         INTEGER LENGTH
  3048.         EXTERNAL ZPTMES,SKIPBL,LENGTH
  3049.  
  3050. C If comments are "verbatim", output it and return
  3051.  
  3052.         IF (CMMODE.EQ.2) THEN
  3053. C .. but add a sequence number if necessary
  3054.             IF (SEQRQD) CALL ADDSEQ(TOKTXT,LENGTH(TOKTXT)+1)
  3055.             CALL ZPTMES(TOKTXT,IODCUR)
  3056.             RETURN
  3057.         END IF
  3058.  
  3059.         IF (TOKTXT(1).NE.32 .AND. TOKLEN.GT.0) THEN
  3060. C A real comment line -- marginise and (optionally) indent it
  3061.             BUFF(1)=TOKTXT(1)
  3062.             IF (CMCHAR.NE.32) BUFF(1)=CMCHAR
  3063. C Work out where to put the comment text on the line
  3064.             START=LMARGC
  3065.             IF (INDCMT) START=MIN(LMARGS+DOLVL*INDDO+IFLVL*INDIF,MAXIND)
  3066.             I=2
  3067.             CALL SKIPBL(TOKTXT,I)
  3068. C If leading spaces past START are significant, don't skip them
  3069.             IF (CMMODE.NE.1 .AND. I.GT.START) I=START
  3070.             IF (TOKTXT(I).EQ.129) THEN
  3071. C A comment line with nothing on it -- Output it as is
  3072.                 BUFF(2)=129
  3073.             ELSE
  3074.                 CMTLEN=LENGTH(TOKTXT(I))
  3075. C If it is too long, try to fit it on anyhow
  3076.                 IF (START+CMTLEN-1.GT.RMARGC) THEN
  3077.                     START=MAX(2,RMARGC-CMTLEN+1)
  3078.                     IF (START+CMTLEN-1.GT.MAX(RMARGC,72)) THEN
  3079.                         CALL PLERR('Comment line too long')
  3080.                     ELSE IF (START+CMTLEN-1.GT.RMARGC) THEN
  3081.                         CALL PLERR('Comment line exceeds margin')
  3082.                     ELSE
  3083.                         CALL PLERR('Can''t indent comment line')
  3084.                     END IF
  3085.                 END IF
  3086. C Indent it with leading spaces
  3087.                 DO 100 POS=2,START-1
  3088.  100                BUFF(POS)=32
  3089. C And copy it into the buffer together with the <eos>
  3090.                 DO 200 POS=I,TOKLEN+1
  3091.  200                BUFF(POS-I+START)=TOKTXT(POS)
  3092.             END IF
  3093.         ELSE
  3094. C A blank comment line -- just output it as a blank line
  3095.             BUFF(1)=BLCHAR
  3096.             BUFF(2)=129
  3097.         END IF
  3098.         IF (SEQRQD) THEN
  3099.             CALL ADDSEQ(BUFF,LENGTH(BUFF)+1)
  3100.         END IF
  3101.         CALL ZPTMES(BUFF,IODCUR)
  3102.         LNUMBR=LNUMBR+SEQINC
  3103.  
  3104.         END
  3105. C ----------------------------------------------------------------------
  3106. C
  3107. C       B R E A K  -  Break a line which is about to be too long
  3108. C
  3109.  
  3110.         SUBROUTINE BREAK
  3111.  
  3112.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  3113.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  3114.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  3115.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  3116.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  3117.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  3118.      +          ,LBLTBO(500),LBLTOP
  3119.         LOGICAL BEGUN,BEGCMT
  3120.  
  3121.         COMMON/OUTLIN/LINE,CURSOR
  3122.         INTEGER LINE(134),CURSOR
  3123.  
  3124.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  3125.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  3126.  
  3127.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  3128.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  3129.      +          NXTTXT(1322)
  3130.  
  3131.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  3132.         INTEGER INDDO,INDIF,INDCON,MAXIND
  3133.         LOGICAL INDCMT
  3134.  
  3135.         SAVE
  3136.  
  3137.         INTEGER NEWLIN(1322),PNTR,CONPOS,SAVEPL
  3138.         LOGICAL OUTCC
  3139.  
  3140.         EXTERNAL SKIPBL,SCOPY
  3141.  
  3142.         IF (CONCOL.GT.0 .AND. INDCON.LT.0) THEN
  3143.             CONPOS=CONCOL
  3144.         ELSE
  3145.             CONPOS=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,MAXIND)+
  3146.      +             ABS(INDCON)
  3147.         END IF
  3148.         IF (TOKLEN+CONPOS+CURSOR-BRKPOS.GT.RMARGS) BRKPOS=0
  3149.  
  3150. C Ok, here we go...
  3151.         IF (BRKPOS.EQ.0) THEN
  3152.             CALL CONLIN
  3153. C Extraordinary measures for big tokens
  3154.  100        IF (TOKLEN+CURSOR-1.GT.RMARGS) THEN
  3155.  
  3156.                 IF (TOKLEN+6.GT.RMARGS .AND. RMARGS.LT.72)
  3157.      +              CALL PLERR('Token extends past RMARGS - n'//
  3158.      +                         'ot truncated o'//'r split')
  3159. C If it is really enormous, overflow it to the next con. line as well
  3160.                 IF (TOKLEN+6.GT.72) THEN
  3161.                     CALL SCOPY(TOKTXT,67,NEWLIN,1)
  3162.                     TOKTXT(67)=129
  3163.                     CALL SCOPY(TOKTXT,1,LINE,7)
  3164.                     CURSOR=73
  3165.                     CALL CONLIN
  3166.                     CURSOR=7
  3167.                     TOKLEN=TOKLEN-66
  3168.                     CALL SCOPY(NEWLIN,1,TOKTXT,1)
  3169. C Loop back in case token is *REALLY* big
  3170.                     GOTO 100
  3171.  
  3172. C Not enormous, just big -- so make it fit (just) onto this line
  3173.                 ELSE IF (TOKLEN+6.GT.RMARGS) THEN
  3174.                     CURSOR=7
  3175.                 ELSE
  3176.                     CURSOR=RMARGS-TOKLEN+1
  3177.                 END IF
  3178.             END IF
  3179.  
  3180. C Line break position is ok, so just do it
  3181.         ELSE
  3182.             PNTR=BRKPOS
  3183.             LINE(CURSOR)=129
  3184.             CALL SKIPBL(LINE,PNTR)
  3185.             CALL SCOPY(LINE,PNTR,NEWLIN,1)
  3186.             CURSOR=BRKPOS
  3187.             OUTCC=.TRUE.
  3188.             SAVEPL=PRNLVL
  3189.             DO 200 PNTR=BRKPOS,80
  3190.                 IF (LINE(PNTR).EQ.39) THEN
  3191.                     OUTCC=.NOT.OUTCC
  3192.                 ELSE IF (OUTCC .AND. LINE(PNTR).EQ.40) THEN
  3193.                     PRNLVL=PRNLVL-1
  3194.                 ELSE IF (OUTCC .AND. LINE(PNTR).EQ.41) THEN
  3195.                     PRNLVL=PRNLVL+1
  3196.                 END IF
  3197.  200            LINE(PNTR)=32
  3198.             CALL CONLIN
  3199.             PRNLVL=SAVEPL
  3200.             MINBRK=(CURSOR+RMARGS)/2
  3201.             CALL SCOPY(NEWLIN,1,LINE,CURSOR)
  3202.  300        IF (LINE(CURSOR).NE.129) THEN
  3203.                 CURSOR=CURSOR+1
  3204.                 GOTO 300
  3205.             END IF
  3206.             LINE(CURSOR)=32
  3207.             BRKPRI=0
  3208.             BRKPOS=0
  3209.         END IF
  3210.  
  3211.         END
  3212. C ----------------------------------------------------------------------
  3213. C
  3214. C       C O N L I N  -  Make a Continuation to the current Line.
  3215. C                       Usually just writes the current line and sets up
  3216. C                       a continuation line, but can sometimes break a
  3217. C                       statement into 2 or more if the maximum number
  3218. C                       of continuation lines is exceeded.
  3219. C
  3220.  
  3221.         SUBROUTINE CONLIN
  3222.  
  3223. C---------------------------------------------------------
  3224. C    TOOLPACK/1    Release: 2.5
  3225. C---------------------------------------------------------
  3226. C
  3227. C  TKLAST = LAST TOKEN NUMBER
  3228. C
  3229.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  3230.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  3231.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  3232.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  3233.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  3234.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  3235.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  3236.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  3237.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  3238.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  3239.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  3240.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  3241.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  3242.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  3243.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  3244.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  3245.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  3246.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  3247.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  3248.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  3249.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  3250.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  3251.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  3252.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  3253.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  3254.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  3255.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  3256.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  3257.  
  3258.  
  3259.         COMMON/OUTLIN/LINE,CURSOR
  3260.         INTEGER LINE(134),CURSOR
  3261.  
  3262.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  3263.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  3264.  
  3265.         COMMON/CONTIN/CONCHR,CONCNT
  3266.         INTEGER CONCHR,CONCNT
  3267.  
  3268.         COMMON/STATE/ LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  3269.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  3270.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  3271.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  3272.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  3273.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  3274.      +          ,LBLTBO(500),LBLTOP
  3275.         LOGICAL BEGUN,BEGCMT
  3276.  
  3277.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  3278.         INTEGER INDDO,INDIF,INDCON,MAXIND
  3279.         LOGICAL INDCMT
  3280.  
  3281.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  3282.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  3283.      +          NXTTXT(1322)
  3284.  
  3285.         COMMON/COMNAM/COMTXT
  3286.         INTEGER COMTXT(1322)
  3287.  
  3288.         INTEGER CON(3,19),TEXT(134),DUMMY(2),I
  3289.  
  3290.         SAVE
  3291.  
  3292.         INTRINSIC ABS
  3293.  
  3294.         INTEGER ZTOKTX,LENGTH
  3295.         EXTERNAL ZTOKTX,LENGTH,SCOPY
  3296.  
  3297.         DATA DUMMY/129,129/
  3298.  
  3299. C *********CONCHR.EQ.1 => Numeric
  3300. C          CONCHR.EQ.2 => Alphabetic
  3301. C          CONCHR.EQ.3 => Numeric then Alphabetic
  3302.  
  3303.         DATA (CON(1,I),I=1,19)/49,50,51,52,53,54,55,
  3304.      +          56,57,49,50,51,52,53,54,55,56,
  3305.      +          57,49/
  3306.         DATA (CON(2,I),I=1,19)/65,66,67,68,69,70,71,
  3307.      +          72,73,74,75,76,77,78,79,80,81,
  3308.      +          82,83/
  3309.         DATA (CON(3,I),I=1,19)/49,50,51,52,53,54,55,
  3310.      +          56,57,65,66,67,68,69,70,71,72,
  3311.      +          73,74/
  3312.  
  3313.         IF (CONCNT.EQ.19 .AND. PRNLVL.EQ.0 .AND.
  3314.      +      (FSTTOK.EQ.TINTEG .OR. FSTTOK.EQ.TLOGIC .OR.
  3315.      +       FSTTOK.EQ.TDOUBL .OR. FSTTOK.EQ.TCOMPL .OR.
  3316.      +       FSTTOK.EQ.TCHARA .OR. FSTTOK.EQ.TREAL) .AND.
  3317.      +       LINE(CURSOR-1).EQ.44) THEN
  3318.             CURSOR=CURSOR-1
  3319.             LINE(CURSOR)=32
  3320.             CALL OUTPUT
  3321.             IF (ZTOKTX(FSTTOK,0,DUMMY,TEXT).NE.-2)
  3322.      +          CALL ERROR('UNEXPECTED ZTOKTX FAILURE')
  3323.             CONCNT=0
  3324.             CURSOR=LMARGS
  3325.             MINBRK=(CURSOR+RMARGS)/2
  3326.             CALL SCOPY(TEXT,1,LINE,CURSOR)
  3327.             CURSOR=CURSOR+LENGTH(TEXT)
  3328.         ELSE IF (CONCNT.EQ.19 .AND. PRNLVL.EQ.0 .AND. FSTTOK.EQ.TCOMMO
  3329.      +           .AND. LINE(CURSOR-1).EQ.44) THEN
  3330.             CURSOR=CURSOR-1
  3331.             LINE(CURSOR)=32
  3332.             CALL OUTPUT
  3333.             IF (ZTOKTX(FSTTOK,0,DUMMY,TEXT).NE.-2)
  3334.      +          CALL ERROR('CONLIN: UNEXPECTED ZTOKTX FAILURE 2')
  3335.             CONCNT=0
  3336.             CURSOR=LMARGS
  3337.             MINBRK=(CURSOR+RMARGS)/2
  3338.             CALL SCOPY(TEXT,1,LINE,CURSOR)
  3339.             CURSOR=CURSOR+LENGTH(TEXT)
  3340.             LINE(CURSOR)=47
  3341.             CURSOR=CURSOR+1
  3342.             DO 100 I=1,LENGTH(COMTXT)
  3343.                 LINE(CURSOR)=COMTXT(I)
  3344.                 CURSOR=CURSOR+1
  3345.                 IF (CURSOR.GT.RMARGS) THEN
  3346.                     CALL OUTPUT
  3347.                     CONCNT=CONCNT+1
  3348.                     IF (CONCHR.LE.32) THEN
  3349.                         LINE(6)=CON(CONCHR,CONCNT)
  3350.                     ELSE
  3351.                         LINE(6)=CONCHR
  3352.                     END IF
  3353.                     IF (INDCON.GE.0 .OR. CONCOL.EQ.0) THEN
  3354.                         CURSOR=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,
  3355.      +                             MAXIND)+ABS(INDCON)
  3356.                     ELSE
  3357.                         CURSOR=CONCOL
  3358.                     END IF
  3359.                 END IF
  3360.  100        CONTINUE
  3361.             LINE(CURSOR)=47
  3362.             CURSOR=CURSOR+1
  3363.             IF (CURSOR.GT.RMARGS)
  3364.      +          CALL ERROR('COMMON SPLITTING FAILED')
  3365.         ELSE
  3366.             CALL OUTPUT
  3367.             CONCNT=CONCNT+1
  3368.             IF (CONCNT.GT.19) THEN
  3369.                 CALL PLERR('Too many continuation lines generated')
  3370.                 CONCNT=1
  3371.             END IF
  3372.             IF (CONCHR.LE.32) THEN
  3373.                 LINE(6)=CON(CONCHR,CONCNT)
  3374.             ELSE
  3375.                 LINE(6)=CONCHR
  3376.             END IF
  3377.             IF (INDCON.GE.0 .OR. CONCOL.EQ.0) THEN
  3378.                 CURSOR=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,MAXIND)+
  3379.      +                 ABS(INDCON)
  3380.             ELSE
  3381.                 CURSOR=CONCOL
  3382.             END IF
  3383.         END IF
  3384.  
  3385.         END
  3386. C ----------------------------------------------------------------------
  3387. C
  3388. C       O U T B L  -  Output a Blank Line
  3389. C
  3390.  
  3391.         SUBROUTINE OUTBL
  3392.  
  3393. C---------------------------------------------------------
  3394. C    TOOLPACK/1    Release: 2.5
  3395. C---------------------------------------------------------
  3396. C
  3397. C  TKLAST = LAST TOKEN NUMBER
  3398. C
  3399.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  3400.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  3401.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  3402.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  3403.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  3404.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  3405.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  3406.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  3407.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  3408.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  3409.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  3410.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  3411.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  3412.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  3413.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  3414.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  3415.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  3416.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  3417.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  3418.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  3419.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  3420.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  3421.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  3422.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  3423.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  3424.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  3425.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  3426.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  3427.  
  3428.  
  3429.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  3430.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  3431.         LOGICAL BLADEC
  3432.  
  3433.         COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  3434.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  3435.  
  3436.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  3437.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  3438.         LOGICAL SEQRQD
  3439.  
  3440.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  3441.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  3442.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  3443.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  3444.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  3445.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  3446.      +          ,LBLTBO(500),LBLTOP
  3447.         LOGICAL BEGUN,BEGCMT
  3448.  
  3449.         COMMON/NAME/ PUNAME
  3450.         CHARACTER*6 PUNAME
  3451.  
  3452.         INTEGER BUFF(134),PTR
  3453.  
  3454.         SAVE
  3455.  
  3456.         EXTERNAL PUTCH,ZOBLNK,ZCHOUT,ZPTINT
  3457.  
  3458.         BUFF(1)=BLCHAR
  3459.         BUFF(2)=129
  3460.         PTR=2
  3461.         IF (SEQRQD) CALL ADDSEQ(BUFF,PTR)
  3462.         CALL ZPTMES(BUFF,IODCUR)
  3463.         LNUMBR=LNUMBR+SEQINC
  3464.         LASTST=TCMMNT
  3465.  
  3466.         END
  3467. C ----------------------------------------------------------------------
  3468. C
  3469. C       O U T C O N  -  Output a "CONTINUE" (line must have a label)
  3470. C
  3471.  
  3472.         SUBROUTINE OUTCON
  3473.  
  3474. C---------------------------------------------------------
  3475. C    TOOLPACK/1    Release: 2.5
  3476. C---------------------------------------------------------
  3477. C
  3478. C  TKLAST = LAST TOKEN NUMBER
  3479. C
  3480.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  3481.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  3482.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  3483.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  3484.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  3485.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  3486.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  3487.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  3488.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  3489.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  3490.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  3491.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  3492.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  3493.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  3494.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  3495.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  3496.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  3497.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  3498.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  3499.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  3500.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  3501.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  3502.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  3503.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  3504.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  3505.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  3506.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  3507.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  3508.  
  3509.  
  3510.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  3511.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  3512.  
  3513.         COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
  3514.         INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
  3515.      +          NXTTXT(1322)
  3516.  
  3517.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  3518.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  3519.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  3520.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  3521.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  3522.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  3523.      +          ,LBLTBO(500),LBLTOP
  3524.         LOGICAL BEGUN,BEGCMT
  3525.  
  3526.         COMMON/OUTLIN/LINE,CURSOR
  3527.         INTEGER LINE(134),CURSOR
  3528.  
  3529.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  3530.         INTEGER INDDO,INDIF,INDCON,MAXIND
  3531.         LOGICAL INDCMT
  3532.  
  3533.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  3534.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  3535.         LOGICAL BLADEC
  3536.  
  3537.         SAVE /MARGIN/,/TOKEN/,/STATE/,/OUTLIN/,/INDENT/,/BLINES/
  3538.  
  3539.         INTEGER SAVTYP,SAVLEN,SAVTXT(1322),TMPTXT(2),JUNK
  3540.  
  3541.         INTEGER ZTOKTX
  3542.         EXTERNAL SCOPY,ZTOKTX
  3543.  
  3544.         IF (BLBEF(TCONTI).GT.0 .AND. LASTST.NE.TCMMNT) CALL OUTBL
  3545.         CALL PROLBL
  3546.  
  3547.         SAVTYP=TOKTYP
  3548.         SAVLEN=TOKLEN
  3549.         IF (TOKLEN.GT.0) CALL SCOPY(TOKTXT,1,SAVTXT,1)
  3550.         TOKTYP=TCONTI
  3551.         TOKLEN=0
  3552.         TMPTXT(1)=129
  3553.         JUNK=ZTOKTX(TOKTYP,TOKLEN,TMPTXT,TOKTXT)
  3554.         CALL CASCVT(TOKTYP,TOKLEN,TOKTXT)
  3555.         TOKLEN=8
  3556.         TOKTXT(9)=129
  3557.         CURSOR=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,MAXIND)
  3558.         CALL OUTTOK
  3559.         CALL OUTPUT
  3560.         TOKTYP=SAVTYP
  3561.         TOKLEN=SAVLEN
  3562.         IF (SAVLEN.GT.0) CALL SCOPY(SAVTXT,1,TOKTXT,1)
  3563.         LASTST=TCONTI
  3564.  
  3565.         END
  3566. C ----------------------------------------------------------------------
  3567. C
  3568. C       S E T C O N   -   Set continuation point
  3569. C
  3570.  
  3571.         SUBROUTINE SETCON
  3572.  
  3573. C---------------------------------------------------------
  3574. C    TOOLPACK/1    Release: 2.5
  3575. C---------------------------------------------------------
  3576. C
  3577. C  TKLAST = LAST TOKEN NUMBER
  3578. C
  3579.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  3580.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  3581.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  3582.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  3583.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  3584.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  3585.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  3586.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  3587.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  3588.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  3589.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  3590.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  3591.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  3592.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  3593.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  3594.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  3595.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  3596.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  3597.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  3598.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  3599.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  3600.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  3601.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  3602.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  3603.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  3604.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  3605.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  3606.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  3607.  
  3608.  
  3609.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  3610.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  3611.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  3612.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  3613.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  3614.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  3615.      +          ,LBLTBO(500),LBLTOP
  3616.         LOGICAL BEGUN,BEGCMT
  3617.  
  3618.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  3619.         INTEGER INDDO,INDIF,INDCON,MAXIND
  3620.         LOGICAL INDCMT
  3621.  
  3622.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  3623.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  3624.  
  3625.         COMMON/DECLUP/DLUP,DLEN,DLUPOS
  3626.         LOGICAL DLUP
  3627.         INTEGER DLEN,DLUPOS
  3628.  
  3629.         COMMON/TYPES/ STTYPE
  3630.         INTEGER STTYPE(TKLAST)
  3631.  
  3632.         COMMON/OUTLIN/LINE,CURSOR
  3633.         INTEGER LINE(134),CURSOR
  3634.  
  3635.         SAVE
  3636.  
  3637. C Make sure we don't line up a continuation line further than half-way
  3638. C along that portion of the line we are using (or, for the DLUP feature,
  3639. C more that 2/3rds of the way along the line of a declarative statement)
  3640.         IF (DLUP .AND. STTYPE(FSTTOK).EQ.3) THEN
  3641.             IF (CURSOR.LE.(LMARGS+2*RMARGS)/3) CONCOL=CURSOR
  3642.         ELSE IF (CURSOR.LE.(LMARGS+INDDO*DOLVL+INDIF*IFLVL+RMARGS)/2)
  3643.      +  THEN
  3644.             CONCOL=CURSOR
  3645.         END IF
  3646.  
  3647.         END
  3648. C ----------------------------------------------------------------------
  3649. C
  3650. C       P L E R R  -  Output a PL error message to both err & o/p files
  3651. C
  3652.  
  3653.         SUBROUTINE PLERR(ERRTXT)
  3654.         CHARACTER*(*) ERRTXT
  3655.  
  3656.         COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  3657.         INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
  3658.  
  3659.         COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
  3660.      +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
  3661.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
  3662.         INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
  3663.      +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
  3664.      +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
  3665.      +          ,LBLTBO(500),LBLTOP
  3666.         LOGICAL BEGUN,BEGCMT
  3667.  
  3668.         COMMON/ERTEST/NERROR
  3669.         INTEGER NERROR
  3670.  
  3671.         COMMON/NAME/PUNAME
  3672.         CHARACTER*6 PUNAME
  3673.  
  3674.         COMMON/ERROPT/ERRCMT
  3675.         LOGICAL ERRCMT
  3676.  
  3677.         SAVE
  3678.  
  3679.         INTEGER ILN(5),I,ERRLEN
  3680.         CHARACTER JUNK
  3681.         CHARACTER*4 LN
  3682.         CHARACTER*134 ERRMSG
  3683.  
  3684.         INTRINSIC LEN
  3685.  
  3686.         CHARACTER ZCITOC
  3687.         EXTERNAL REMARK,ZMESS,ZITOCP,ZCITOC
  3688.  
  3689.         ERRLEN=LEN(ERRTXT)
  3690.         CALL ZITOCP(LNUMBR,ILN,4,32)
  3691.         DO 100 I=1,4
  3692.  100        JUNK=ZCITOC(ILN(I),LN(I:I))
  3693.         ERRMSG='Line '//LN//', '//PUNAME//': '//ERRTXT
  3694.         CALL REMARK(ERRMSG(1:ERRLEN+19))
  3695.         IF (ERRCMT) THEN
  3696.             ERRMSG='C*PL*ERROR* '//ERRTXT
  3697.             CALL ZMESS(ERRMSG(1:ERRLEN+12),IODCUR)
  3698.         END IF
  3699.         NERROR=NERROR+1
  3700.  
  3701.         END
  3702. C ----------------------------------------------------------------------
  3703. C
  3704. C       Z P L E R R   -   Return number of errors discovered by polish
  3705. C
  3706.  
  3707.         INTEGER FUNCTION ZPLERR()
  3708.  
  3709.         COMMON/ERTEST/NERROR
  3710.         INTEGER NERROR
  3711.  
  3712.         SAVE
  3713.  
  3714.         ZPLERR=NERROR
  3715.  
  3716.         END
  3717.